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
|
Sub Test()
Dim Dico As Object
Dim Cle As Variant
Dim Plage As Range
Dim Cel As Range
Dim T As Variant
Dim Chaine1 As String
Dim Chaine2 As String
Dim AdresseMail As String
Dim I As Integer
Set Dico = CreateObject("Scripting.Dictionary")
'défini la plage sur la colonne N de la feuille active à partir de N2 (colonne des noms)
With ActiveSheet: Set Plage = .Range(.Cells(2, 14), .Cells(.Rows.Count, 14).End(xlUp)): End With
'concatène le Numéro d'équipement avec le montant et l'adresse mail séparés par un tiret bas et ensuite, sépare
'les enregistrements par une virgule
For Each Cel In Plage
Dico(Cel.Value) = Dico(Cel.Value) & Cel.Offset(, 1).Value & "_" & Cel.Offset(, 14).Value & "_" & Cel.Offset(, 11).Value & ","
Next Cel
For Each Cle In Dico.Keys
'splite dans un tableau
T = Split(Dico(Cle), ",")
'construction des deux chaînes
Chaine1 = Cle & "," & vbCrLf & vbCrLf
Chaine2 = "Sauf erreur de notre part, vous nous êtes redevable " & IIf(UBound(T) > 1, "des sommes", "de la somme") & " ci-dessous :" & vbCrLf & vbCrLf
For I = 0 To UBound(T) - 1
'mémorise l'adresse mail
If AdresseMail = "" Then AdresseMail = Split(T(I), "_")(2)
'extrait le numéro d'équipement et le montant et inscrit les enregistrement les uns sous les autres
Chaine2 = Chaine2 & "pour le numéro d'équipement " & Split(T(I), "_")(0) & " d'un montant de " & Split(T(I), "_")(1) & vbCrLf
Next I
'finalise la chaîne
Chaine1 = Chaine1 & Chaine2 & vbCrLf & "En l'attente de votre règlement, veuillez agréer, " & Cle & ", mes sincères salutations."
Chaine1 = Chaine1 & vbCrLf & vbCrLf & "ElMizuno41"
'envoi des mails
EnvoiMail Chaine1, AdresseMail, "Relance ElMizuno41."
'vide pour le suivant
Chaine1 = "": Chaine2 = "": AdresseMail = ""
Next Cle
End Sub
Sub EnvoiMail(TexteMail As String, AdresseMail As String, Sujet As String)
Dim AppOutlook As Object
Dim OutMail As Object
Set AppOutlook = CreateObject("Outlook.Application")
Set OutMail = AppOutlook.CreateItem(0)
With OutMail
.To = AdresseMail
.Subject = Sujet
.Body = TexteMail
'.Display 'montre l'application
.Send
End With
Set OutMail = Nothing
Set AppOutlook = Nothing
End Sub |
Partager