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
| With Sheets("mail")
For envoi = 2 To WorksheetFunction.CountA(.Columns("A"))
type_etude = .Range("A" & envoi)
projet = .Range("B" & envoi)
fichier = .Range("C" & envoi)
Sleep (3000)
Subj = "Bulletin " & projet & " de " & mois_source
nb_destinataires = WorksheetFunction.CountA(.Rows(envoi)) - 5
For a_envoyer_a = 6 To WorksheetFunction.CountA(.Rows(envoi))
If a_envoyer_a = 6 Then
destinataire = .Cells(envoi, a_envoyer_a)
Else: destinataire = destinataire & "," & .Cells(envoi, a_envoyer_a)
End If
Next a_envoyer_a
EmailAddr = destinataire
If nb_destinataires = 1 Then
prenom = " " & .Range("E" & envoi)
Else: prenom = ""
End If
Msg = "Bonjour" & prenom & ", " & vbCrLf & " " & vbCrLf & "Vous trouverez ci-joint le bulletin & type_etude & " " & projet & " construit à partir des données " & donnees_source & "." _
& vbCrLf & "Si vous avez des questions ou si vous souhaitez des informations complémentaires, n'hésitez pas à me contacter." _
& vbCrLf & "" & vbCrLf & "Cordialement" & vbCrLf & "" & vbCrLf & "Xxxxxxx XXXXXX" & vbCrLf & "XX XXX"
hlink = "mailto:" & EmailAddr & "?"
hlink = hlink & "subject=" & Subj & "&"
hlink = hlink & "body=" & Msg
Stop
Shell "C:\Program Files\Outlook Express\msimn.exe " & "/mailurl:" & hlink
Sleep (3000)
SendKeys "%s", True
Next envoi
End With
End Sub |
Partager