Macro envoi mail Excel Outlook en 4 niveaux de difficulté
Introduction
4 niveaux pour créer une macro envoi mail Excel Outlook. Automatiser envoi mail Excel.
1. Niveau débutant - utilise cette macro simple pour envoyer un mail Outlook à partir d'Excel
Tu veux pouvoir automatiquement envoyer un mail Outlook depuis Excel ? Suis le code super simple ci-dessous :
Sub envoi_mail_debutant()
Dim OutApp As Object 'Déclaration de l'objet application Outlook
Dim OutMail As Object 'Déclaration de l'objet mail Outlook
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "contact@sap-automation.com"
.CC = "contact@sap-automation.com; youremailadress@gmail.com" 'adresses en copie
.BCC = Worksheets("mail").Range("B3") 'recherche la valeur dans la cellule B1 de la
'feuille "mail" // adresses en copie cachée
.Subject = "Mail" & " à " & Date & " " & Time
'sépare deux valeurs avec un &
'le texte écrit 'en dur' doit toujours être entouré de ""
'Date & Time sont des fonctions qui permettent d'avoir la date/heure de création du mail
.Body = "Ceci est un message de test" & vbCrLf & "saut de ligne"
'ajoutez & vbCrLf & pour aller à la ligne entre deux valeurs
.Attachments.Add ActiveWorkbook.FullName 'Ajoute le classeur actif en pièce jointe
'.Attachments.Add "C:\MonDossier\MonFichier.xlsx"
'Ajoute une pièce jointe à votre mail, indiquez le chemin complet vers le fichier que vous voulez
'joindre
.Display 'affiche le mail en brouillon dans Outlook
'.Send 'envoie directement le mail
'.Save 'sauvegarde le mail
End With
Set OutMail = Nothing 'nettoie la mémoire en nettoyant les variables
Set OutApp = Nothing
End sub
2. Niveau Intermédiaire - formate le mail (gras, souligné, italique, couleurs, coupures) avec du HTML simple
Grâce à HTML, tu peux facilement :
- Mettre en forme le texte de ton mail
- Mettre ton texte en italique, en gras, souligné, en rouge, etc.
- Pour plus d'options de formatage de texte HTML, consulte ce site - les possibilités sont immenses !
Sub envoi_mail_intermediaire()
' Déclare les objets application et élément de messagerie Outlook
Dim OutApp As Object
Dim OutMail As Object
' Crée une nouvelle instance de l'application Outlook
Set OutApp = CreateObject("Outlook.Application")
' Crée un nouvel élément de messagerie
Set OutMail = OutApp.CreateItem(0)
' Avec l'élément de messagerie
With OutMail
' Définit l'adresse e-mail du destinataire
.To = "contact@sap-automation.com"
' Affiche l'e-mail
.Display
' Définit le sujet de l'e-mail pour inclure la date et l'heure actuelles
.Subject = "Rapport du : " & Date & " " & Time
' Définit le corps HTML de l'e-mail
.HTMLBody = "Ceci est un test" & "<br><br>" & _
"Ceci est un texte après un saut de ligne " & "<br>" & _
"Ceci est un texte sur la ligne" & "<br>" & _
"<b> ceci est un texte en gras </b> " & "<br>" & _
"<u> ceci est un texte souligné </u> " & "<br>" & _
"<b><u> ceci est un texte en gras et souligné </u></b> " & "<br>" & _
"<i> ceci est un texte en italique </i> " & "<br>" & _
"<FONT COLOR=RED> ceci est un texte en rouge </FONT>" & "<br>" & _
.HTMLBody
' Fin de l'instruction With
End With
' Libère les objets élément de messagerie et application Outlook
Set OutMail = Nothing
Set OutApp = Nothing
End sub
3. Niveau Avancé - Mail Outlook avec plage de données Excel dans le corps du mail à l'aide d'une fonction
En utilisant une fonction (très simple), tu peux intégrer un tableau ou une série de données dans le corps de ton mail.
Sub envoi_mail_avance()
Dim OutApp As Object
Dim OutMail As Object
Dim plage_mail As Range 'Déclare une plage de cellules pour le mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set plage_mail = ThisWorkbook.Sheets("mail").Range("A1").CurrentRegion 'Définit la plage de cellules pour le mail
With OutMail
.To = "contact@sap-automation.com"
.Display 'affiche le mail en brouillon dans Outlook
'.Send 'envoie directement le mail
'.Save 'sauvegarde le mail
.Subject = "Rapport du : " & Date & " " & Time
.HTMLBody = "Veuillez trouver ci-dessous le rapport," & "<br><br>" & _
RangetoHTML(plage_mail) & "<br><br>" & _
.HTMLBody 'Définit le corps du mail en HTML
End With
Set OutMail = Nothing 'Libère l'objet mail
Set OutApp = Nothing 'Libère l'objet application Outlook
End sub
Pour que cette macro fonctionne, tu dois ajouter la fonction ci-dessous dans le même module :
Public Function RangetoHTML(rng_mail As Range)
Dim fso As Object 'Déclare l'objet système de fichiers
Dim ts As Object 'Déclare l'objet flux de texte
Dim TempFile As String 'Déclare la variable de chaîne pour le fichier temporaire
Dim TempWB As Workbook 'Déclare le classeur temporaire
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Définit le chemin du fichier temporaire
'Copie la plage et crée un nouveau classeur pour coller les données
rng_mail.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Excel.Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publie la feuille dans un fichier htm
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Lit toutes les données du fichier htm dans RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Ferme TempWB
TempWB.Close savechanges:=False
'Supprime le fichier htm que nous avons utilisé dans cette fonction
Kill TempFile
Set ts = Nothing 'Nettoie l'objet flux de texte
Set fso = Nothing 'Nettoie l'objet système de fichiers
Set TempWB = Nothing 'Nettoie le classeur temporaire
End Function
4. Niveau Avancé 2 - Mail Outlook avec graphique en pièce jointe
Ajoute un graphique en pièce jointe au mail Outlook.
Sub envoi_mail_graphique()
Dim OutApp As Object 'Déclare l'objet application Outlook
Dim OutMail As Object 'Déclare l'objet mail Outlook
Dim xChartName As String 'Déclare une variable de type chaîne pour contenir le nom du graphique
Dim xChartPath As String 'Déclare une variable de type chaîne pour contenir le chemin du graphique
Dim xPath As String 'Déclare une variable de type chaîne pour contenir le chemin
Dim xChart As ChartObject 'Déclare une variable de type ChartObject pour contenir l'objet graphique
On Error Resume Next 'Ignore toute erreur et continue l'exécution
xChartName = "chart" 'Attribue le nom du graphique
If xChartName = "" Then Exit Sub 'Quitte la sous-routine si le nom du graphique est vide
Set xChart = ThisWorkbook.Sheets("graph").ChartObjects(xChartName) 'Définit l'objet graphique sur le graphique spécifié de la feuille "graph"
If xChart Is Nothing Then Exit Sub 'Quitte la sous-routine si l'objet graphique n'est pas défini
Set OutApp = CreateObject("Outlook.Application") 'Crée une nouvelle instance de l'application Outlook
Set OutMail = OutApp.CreateItem(0) 'Crée un nouvel élément de messagerie
xChartPath = ThisWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp" 'Définit le chemin du graphique sur le chemin du classeur actuel, le nom d'utilisateur actuel et la date et l'heure actuelles
xChart.Chart.Export xChartPath 'Exporte le graphique vers le chemin spécifié
With OutMail
.To = "contact@sap-automation.com" 'Définit le destinataire du mail
.Subject = "Rapport de graphique du : " & Date & " " & Time 'Définit le sujet du mail à "Rapport de graphique du : " suivi de la date et de l'heure actuelles
.Attachments.Add xChartPath 'Ajoute le graphique exporté en pièce jointe
.HTMLBody = "Veuillez trouver le graphique en pièce jointe." & "<br><br>" & _
.HTMLBody 'Définit le corps du mail à "Veuillez trouver le graphique en pièce jointe." suivi de deux sauts de ligne et du corps actuel du mail
.Display 'Affiche le mail
End With
Kill xChartPath 'Supprime le fichier temporaire du graphique
Set OutMail = Nothing 'Nettoyage
Set OutApp = Nothing 'Nettoyage
End Sub
5. Niveau Expert - Mail Outlook avec tableau et graphique dans le corps du mail
Ajoute un tableau et un graphique dans le corps du mail Outlook.
Sub envoi_mail_expert()
Dim OutlookApp As Object 'Déclare l'objet application Outlook
Dim OutlookMail As Object 'Déclare l'objet mail Outlook
Dim consolidationSheet As Worksheet 'Déclare l'objet pour la feuille de consolidation
Dim chartObject As chartObject 'Déclare l'objet graphique
Dim tableRange As Range 'Déclare l'objet de plage pour le tableau
Dim chartFilePath As String 'Déclare la variable de chaîne pour le chemin du fichier graphique
Dim tableHTML As String 'Déclare la variable de chaîne pour le HTML du tableau
'Définit la feuille de consolidation
Set consolidationSheet = ThisWorkbook.Worksheets("CONSOLIDATION")
Set chartObject = consolidationSheet.ChartObjects("chart_example") 'Définit l'objet graphique
'Définit la plage du tableau
Set tableRange = consolidationSheet.ListObjects("CONSOLIDATION").Range
'Enregistre l'image du graphique en tant que fichier temporaire
chartFilePath = Environ$("temp") & "\chart.jpg"
chartObject.Chart.Export chartFilePath, "JPG"
tableHTML = ConvertRangeToHTML(tableRange) 'Convertit la plage du tableau en HTML
Set OutlookApp = CreateObject("Outlook.Application") 'Crée un nouvel e-mail Outlook
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "contact@sap-automation.com"
.Subject = "Rapport de consolidation du : " & Date & " " & Time
.HTMLBody = .HTMLBody & "<p>Bonjour, veuillez trouver ci-dessous le tableau et le graphique du jour :</p>"
.HTMLBody = .HTMLBody & "<table border='1' cellpadding='5' style='border-collapse: collapse;'>"
.HTMLBody = .HTMLBody & tableHTML
.HTMLBody = .HTMLBody & "</table>"
.HTMLBody = .HTMLBody & "<br><img src='cid:chart' width='600' height='400'>"
.HTMLBody = .HTMLBody & "</body></html>"
'Attache l'image du graphique en tant qu'image intégrée
.Attachments.Add chartFilePath, 1, 0, "chart.jpg"
.Attachments("chart.jpg").PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", "chart"
.Display 'Affiche l'e-mail (changez en .Send pour envoyer sans afficher)
End With
Kill chartFilePath 'Supprime le fichier temporaire
Set OutlookMail = Nothing 'Nettoyage
Set OutlookApp = Nothing 'Nettoyage
End Sub
Pour que cette macro fonctionne, tu dois ajouter la fonction ci-dessous dans le même module :
Function ConvertRangeToHTML(rng As Range) As String
Dim htmlTable As String 'Déclare la variable de chaîne pour le tableau HTML
Dim row As Range 'Déclare l'objet de plage pour la ligne
Dim cell As Range 'Déclare l'objet de plage pour la cellule
'Début du tableau HTML
htmlTable = "<thead><tr>"
For Each cell In rng.Rows(1).Cells
htmlTable = htmlTable & "<th>" & cell.Value & "</th>" 'Ajoute chaque cellule de la première ligne de la plage à l'en-tête du tableau
Next cell
htmlTable = htmlTable & "</tr></thead><tbody>"
'Ajoute les lignes et les cellules au tableau
For Each row In rng.Rows
If row.row <> rng.Rows(1).row Then
htmlTable = htmlTable & "<tr>"
For Each cell In row.Cells
htmlTable = htmlTable & "<td>" & cell.Value & "</td>"
Next cell
htmlTable = htmlTable & "</tr>"
End If
Next row
htmlTable = htmlTable & "</tbody>"
ConvertRangeToHTML = htmlTable
End Function