1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
| Public Sub RelanceMail_SF_SP()
'On Error Resume Next
Dim Session As Object
Dim db As Object
Dim doc As Object
Dim EmbedObj As Object
Dim Compte As Integer
Dim MaFeuill3 As String
Dim MonMail As String
Dim Verif3 As Integer
'Nom de l'onglet
MaFeuille3 = "Mail"
Verif3 = 0
'Numéro de Colonnes
FirstLigne = 6
ColDebRel = 23
ColFinRel = 24
ColSucces = 25
ColMail = 30
For Each Ws In Worksheets
If Ws.Name = MaFeuille3 Then
Verif3 = 1
Exit For
End If
Next Ws
If Verif3 < 1 Then
MsgBox "Vous n'avez pas copier/coller l'onglet 'Mail'" & vbCrLf & "Arrêt de la Macro", vbInformation, "ERREUR"
Exit Sub
End If
If Sheets(MaFeuille3).Cells(34, 3).Value = "Absente" And Sheets(MaFeuille3).Cells(34, 6).Value = "Absente" Then
MsgBox "Il faut au moins une personne au statut 'Présente' dans l'onglet 'Mail'" & vbCrLf & "Arrêt de la Macro", vbInformation, "ERREUR"
Exit Sub
End If
'Dernière ligne du tableau de Synthèse
LastLigne = Feuil2.Cells(65536, 7).End(xlUp).Row '<<<<<<<<<<<<<<<<<<<<< Feuil2 = SF_SP et Feuil3 = SNF_IND
'Ouverture d'une session Notes
Set Session = CreateObject("notes.notessession")
Set db = Session.GetDatabase("", "")
Call db.OPENMAIL
'Plage Colonne Début Date de Relance
Set plage = Feuil2.Range(Feuil2.Cells(6, ColDebRel), Feuil2.Cells(LastLigne, ColDebRel)) '<<<<<<<<<<<<<<<<<<<<<
Compte = 0
For Each Cellule In plage
If Cellule.Offset(0, 2) = 1 And Cellule.Offset(0, 1) >= Date Then
Cellule.Offset(0, 1).Value = "Stop le " & Date
End If
If Cellule <= Date And Cellule.Offset(0, 1) >= Date And Cellule.Offset(0, 2) <> 1 And Cellule.Offset(0, 7) <> "" Then
Set doc = db.CreateDocument
MailDestinataire = Cellule.Offset(0, 7)
MailCopie = Cellule.Offset(0, 8)
Sujet = "[" & Cellule.Offset(0, -16) & "]" & " " & Sheets(MaFeuille3).Cells(8, 6)
If Sheets(MaFeuille3).Cells(34, 3).Value = "Présente" Then '<<<<<<<<<<<<<<<<<<<<<
CorpsMessage = Sheets(MaFeuille3).Cells(10, 3) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(12, 3) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(14, 3) & " " & Cellule.Offset(0, -15) & " " & Cellule.Offset(0, -12) & " " & Sheets(MaFeuille3).Cells(15, 3) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(17, 3) & vbCrLf & _
Sheets(MaFeuille3).Cells(18, 3) & " " & Cellule.Offset(0, -7) & "" & vbCrLf & _
Sheets(MaFeuille3).Cells(19, 3) & " " & Cellule.Offset(0, -8) & "" & vbCrLf & _
Sheets(MaFeuille3).Cells(20, 3) & " " & Cellule.Offset(0, -9) & "" & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(22, 3) & vbCrLf & _
Cellule.Offset(0, -4) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(24, 3) & vbCrLf & _
Cellule.Offset(0, -5) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(27, 3) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(29, 3) & vbCrLf & Sheets(MaFeuille3).Cells(30, 3) & vbCrLf & Sheets(MaFeuille3).Cells(31, 3) '<<<<<<<<<<<<<<<<<<<<<
MonMail = Sheets(MaFeuille3).Cells(32, 3).Value '<<<<<<<<<<<<<<<<<<<<<
ElseIf Sheets(MaFeuille3).Cells(34, 3).Value = "Absente" Then '<<<<<<<<<<<<<<<<<<<<<
CorpsMessage = Sheets(MaFeuille3).Cells(10, 3) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(12, 3) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(14, 3) & " " & Cellule.Offset(0, -15) & " " & Cellule.Offset(0, -12) & " " & Sheets(MaFeuille3).Cells(15, 3) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(17, 3) & vbCrLf & _
Sheets(MaFeuille3).Cells(18, 3) & " " & Cellule.Offset(0, -7) & "" & vbCrLf & _
Sheets(MaFeuille3).Cells(19, 3) & " " & Cellule.Offset(0, -8) & "" & vbCrLf & _
Sheets(MaFeuille3).Cells(20, 3) & " " & Cellule.Offset(0, -9) & "" & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(22, 3) & vbCrLf & _
Cellule.Offset(0, -4) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(24, 3) & vbCrLf & _
Cellule.Offset(0, -5) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(27, 6) & vbCrLf & vbCrLf & _
Sheets(MaFeuille3).Cells(29, 6) & vbCrLf & Sheets(MaFeuille3).Cells(30, 6) & vbCrLf & Sheets(MaFeuille3).Cells(31, 6) '<<<<<<<<<<<<<<<<<<<<<
MonMail = Sheets(MaFeuille3).Cells(32, 6).Value '<<<<<<<<<<<<<<<<<<<<<
End If
With doc
.Form = "Memo"
.sendto = MailDestinataire
.copyto = MailCopie
.Subject = Sujet
.Body = CorpsMessage
.Replyto = MonMail
.SaveMessageOnSend = True
.PostedDate = Now
.SenderTag = "M"
.deliverypriority = "H"
.Importance = "1"
End With
Call doc.Send(False)
Compte = Compte + 1
Application.StatusBar = Compte & " Mails envoyés"
End If
Next Cellule
Set plage = Nothing
Set Session = Nothing
Set db = Nothing
Set doc = Nothing
Application.StatusBar = False
MsgBox "PubliMailing Terminé" & vbCrLf & Compte & " Mails envoyés", vbInformation, "RELANCES AUTO"
End Sub |
Partager