pierre31270
XLDnaute Junior
J'ai pas mal avancé sur le sujet mais ma macro n'arrive pas à passer à la ligne suivante, quelqu'un pourrait-il y jeter un oeil s'il vous plait?
next ne marche pas
Merci d'avance à vous
Pierre
next ne marche pas
Merci d'avance à vous
Pierre
Code:
Sub EnvoiEmailAuto()
Dim OlApp As Outlook.Application
Dim OlItem As Outlook.MailItem
Set OlApp = CreateObject("Outlook.application")
Set OlItem = OlApp.CreateItem(olMailItem)
i = 2
While (Cells(i, 4) <> "")
With OlItem
'Dim destinataires, chemin d'acces au fichier à joindre, date concernés
Dest = Sheets("Mailing").Cells(i, 4)
PathName = Sheets("Mailing").Cells(i, 5)
Date1 = Sheets("Mailing").Range("F1")
'.To = dest
.Recipients.Add (Dest)
'.CC = "xxxxx.xxxx@xxxxxxx.xxx"
.Subject = "Relevé Mensuel"
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><body><img src='C:\Users\user\Desktop\Normal.jpg'><br>" _
& "Bonjour,<p>" _
& "Veuillez trouver ci-joint votre relevé de " & "<b> Date1 </b><p>" _
& "Bonne journée<p>" _
& "Pierre<p>" _
& "</body><HTML>"
.Attachments.Add PathName
.Send
End With
Sheets("Mailing").Cells(i, 1) = "Envoyé"
MsgBox ("Suivant ?")
i = i + 1
Wend
End Sub
