Mailing Excel -> Outlook 2013
Bonjour,
J'essaie de créer un script pour automatiser l'envoie de courrier à une liste de mails depuis une feuille excel (une ligne sur une colone) via outlook.
Cela me semblait facile à mettre en place au début mais j'avoue que je patauge car je débute en VBA... L'idée est de prendre chaque cellule (mail) comme destinataire ainsi que l'incorporer dans le corps du mail puis avoir un "aperçu" avant envoi de ceux-ci
Voici ce que j'ai essayé de faire jusqu'à présent:
Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim data As String
Dim outlookObj As Object
Set outlookObj = CreateObject("Outlook.Application")
Set Mail = outlookObj.CreateItem(0)
With Mail.CreateItem(olMailItem)
.Subject = "Migration Alias"
.To = Range("A:A")
.BodyFormat = olFormatRichText
.Body = "Madame, Monsieur,
Dans le cadre de la modernisation de l'infrastructure d'envoi des E-mails, nous procédons à une vérification des alias qui sont utilisés.
Votre adresse personnelle est liée à l'alias "Range("A:A")". Pouvez-vous nous indiquer, par réponse à cet E-mail, si cet alias est toujours utilisé ?
D 'avance, nous vous remercions pour votre collaboration.
Bien cordialement"
.Display
End With
End SubPourriez-vous m'aider où m'aiguiller vers un lien/tuto?
D'avance un grand merci
Bonjour @ tous,
Un publipostage avec Word fera l'affaire.
Cordialement
Ok, je vais essayer cette solution, merci pour votre conseil
Bonjour Ced87 et le forum,
une proposition à tester, à insérer dans un module standard:
Sub test3()
'https://forum.excel-pratique.com/viewtopic.php?f=2&t=131660
Dim LastRow As Long
Dim cel As Range
Dim i As Long
Dim Destinataire As String, Message As String
Dim outlookObj As Object, Mail As Object
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each cel In Range("A1:A" & LastRow) 'Plage à adapter
On Error Resume Next
Destinataire = cel.Value
Message = "Madame, Monsieur," & vbNewLine & _
"Dans le cadre de la modernisation de l'infrastructure d'envoi des E-mails, nous procédons à une vérification des alias qui sont utilisés." & vbNewLine & _
"Votre adresse personnelle est liée à l'alias " & Destinataire & ". Pouvez-vous nous indiquer, par réponse à cet E-mail, si cet alias est toujours utilisé ? " & vbNewLine & _
"D'avance, nous vous remercions pour votre collaboration." & vbNewLine & _
"Bien cordialement"
Set outlookObj = CreateObject("Outlook.Application")
Set Mail = outlookObj.CreateItem(0)
With Mail
.To = Destinataire
.Subject = "Migration Alias"
.body = Message
.Display
End With
Next cel
Application.ScreenUpdating = True
End SubSuper, merci beaucoup pour votre aide
Bonjour,
Tout fonctionne parfaitement avec le code VBA (avec word il ne parvient pas à insérer l'adresse dans le corps du mail) mais je cale sur une dernière subtilité, j'aimerais ajouté ma signature par défaut sous outlook, j'ai trouvé des informations et ai tenté de changer le code avec la balise ".HTMLBody", ça fonctionne mais les images de la-dite signature sont déformées. Est-il possible d'ajouter la signature au code de base sans tout modifier?
Sub data()
Dim LastRow As Long
Dim cel As Range
Dim i As Long
Dim Destinataire As String, Message As String
Dim outlookObj As Object, Mail As Object
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each cel In Range("A1:A" & LastRow)
On Error Resume Next
Destinataire = cel.Value
Message = "Message du mail"
Set outlookObj = CreateObject("Outlook.Application")
Set Mail = outlookObj.CreateItem(0)
With Mail
.SentOnBehalfOfName = "support@***.be"
.To = Destinataire
.Subject = "Migration Alias"
.body = Message
.ReadReceiptRequested = True
.Display
'Envoyer le mail automatiquement
'.Send
End With
Next cel
Application.ScreenUpdating = True
End SubCode HTML:
Sub data()
Dim LastRow As Long
Dim cel As Range
Dim i As Long
Dim Destinataire As String, strbody As String
Dim outlookObj As Object, Mail As Object
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each cel In Range("A1:A" & LastRow)
On Error Resume Next
Destinataire = cel.Value
strbody = "Message du mail"
Set outlookObj = CreateObject("Outlook.Application")
Set Mail = outlookObj.CreateItem(0)
With Mail
.SentOnBehalfOfName = "support@***.be"
.Display
.To = Destinataire
.Subject = "Migration Alias"
.HTMLBody = strbody & "<br>" & .HTMLBody
.ReadReceiptRequested = True
'Envoyer le mail automatiquement
'.Send
End With
Next cel
Application.ScreenUpdating = True
End SubQu'ai-je loupé comme information?
Merci pour votre précieuse aide
Bonjour Ced87,
ça devrait marcher:
Sub test4()
'https://forum.excel-pratique.com/viewtopic.php?f=2&t=131660
Dim LastRow As Long
Dim cel As Range
Dim i As Long
Dim Destinataire As String, Message As String, Signature As String
Dim outlookObj As Object, Mail As Object
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each cel In Range("A1:A" & LastRow) 'Plage à adapter
On Error Resume Next
Destinataire = cel.Value
Message = "<style> body{color:black;font-family:calibri;font-size: 12pt;} </style>" & _
"<HTML><body>Madame, Monsieur,<br><br> " & _
"Dans le cadre de la modernisation de l'infrastructure d'envoi des E-mails, nous procédons à une vérification des alias qui sont utilisés.<br>" & _
"Votre adresse personnelle est liée à l'alias " & Destinataire & ". Pouvez-vous nous indiquer, par réponse à cet E-mail, si cet alias est toujours utilisé ? <br>" & _
"D'avance, nous vous remercions pour votre collaboration.<br>" & _
"Bien cordialement." & "</a></body>"
Set outlookObj = CreateObject("Outlook.Application")
Set Mail = outlookObj.CreateItem(0)
With Mail
.Display
End With
Signature = Mail.HTMLbody
With Mail
.To = Destinataire
.Subject = "Migration Alias"
.HTMLbody = Message & Signature
End With
Next cel
Application.ScreenUpdating = True
End Sub