Public Sub EnvoieMail()
Dim mMessage As Object
Dim mConfig As Object
Dim mSch
Dim oMail As MailItem
DER = Sheets("BDD").Range("E55").End(xlUp).Row
For a = 3 To DER
Destination = Sheets("BDD").Cells(a, 5).Value
Set mConfig = CreateObject("CDO.Configuration")
'mConfig.Load -1
Set mSch = mConfig.Fields
With mSch
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.5.20"
'En principe, 25 fonctionne avec tout les serveurs.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
Set mMessage = CreateObject("CDO.Message")
With mMessage
Set .Configuration = mConfig
.To = Destination
.From = UserForm1.ComboBox5
.Subject = UserForm1.ComboBox1
.TextBody = "Bonjour Monsieur, Madame" & vbCrLf & vbCrLf _
& "Veuillez trouvez ci-joint le Rapport d'intervention ainsi que la fiche victime suite a l'accident du travail de l'agent: " & vbCrLf & vbCrLf _
& UserForm1.TextBox20.Value & vbCrLf _
& "Survenue le: " & UserForm1.TextBox18.Value & vbCrLf _
& "En vous souhaitant bonne reception " & vbCrLf & vbCrLf _
& "Cordialement l'agent SSIAP2 SEATH " & ComboBox5 & vbCrLf & vbCrLf _
'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
.AddAttachment ThisWorkbook.Path & "\Rapport.pdf"
.AddAttachment ThisWorkbook.Path & "\rapport mail.pdf"
'Envoie du mail
.Send
End With
'Libère les ressources
Set mMessage = Nothing
Set mConfig = Nothing
Set mSch = Nothing
'Message de confirmation d'envoie
Next
MsgBox "Le mail a été envoyer"
End Sub