Sub mailto_badge()
With Sheets("badge")
dl = .Cells(Rows.Count, 2).End(xlUp).Row
Set ol = CreateObject("outlook.application")
'--boucle
For i = 2 To dl
'--choix envoi ("x" en colonne G) ou pas
If Cells(i, 7) = "x" Then
Cells(i, 8) = ""
Set ml = ol.createitem(0)
ml.To = .Cells(i, 9)
ml.Subject = .Cells(i, 12)
ml.CC = .Cells(i, 10)
ml.BCC = .Cells(i, 11)
ml.Body = .Cells(i, 13)
'--afficher le mail
ml.Display
'--- si vous souhaitez envoyer directement
'ml.send
'--- afficher date et heure d'envoi
Cells(i, 8) = Now
'---demande AR
ml.OriginatorDeliveryReportRequested = True
'---demande confirmation de lecture
ml.ReadReceiptRequested = True
End If
Next i
End With
End Sub