Excel VBA Macro to Send Outlook Emails - 4 Difficulty Levels
Introduction
4 levels to create an Excel Outlook email sending macro. Automate email sending from Excel.
1. Beginner Level - use this simple macro to send an Outlook email from Excel
Want to automatically send an Outlook email from Excel? Follow the super simple code below:
Sub envoi_mail_debutant()
Dim OutApp As Object 'Declare the Outlook application object
Dim OutMail As Object 'Declare the Outlook mail object
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" 'CC addresses
.BCC = Worksheets("mail").Range("B3") 'looks up the value in cell B1 of the
'"mail" sheet // BCC addresses
.Subject = "Mail" & " at " & Date & " " & Time
'separate two values with &
'hardcoded text must always be enclosed in ""
'Date & Time are functions that return the date/time of mail creation
.Body = "This is a test message" & vbCrLf & "line break"
'add & vbCrLf & to create a line break between two values
.Attachments.Add ActiveWorkbook.FullName 'Adds the active workbook as attachment
'.Attachments.Add "C:\MyFolder\MyFile.xlsx"
'Adds an attachment to your email, specify the full path to the file you want
'to attach
.Display 'displays the email as a draft in Outlook
'.Send 'sends the email directly
'.Save 'saves the email
End With
Set OutMail = Nothing 'cleans memory by clearing the variables
Set OutApp = Nothing
End sub
2. Intermediate Level - format the email (bold, underline, italic, colors, line breaks) with simple HTML
With HTML, you can easily:
- Format the text of your email
- Make your text italic, bold, underlined, red, etc.
- For more HTML text formatting options, check out this site - the possibilities are endless!
Sub envoi_mail_intermediaire()
' Declare the Outlook application and mail item objects
Dim OutApp As Object
Dim OutMail As Object
' Create a new instance of the Outlook application
Set OutApp = CreateObject("Outlook.Application")
' Create a new mail item
Set OutMail = OutApp.CreateItem(0)
' With the mail item
With OutMail
' Set the recipient email address
.To = "contact@sap-automation.com"
' Display the email
.Display
' Set the email subject to include current date and time
.Subject = "Report from: " & Date & " " & Time
' Set the HTML body of the email
.HTMLBody = "This is a test" & "<br><br>" & _
"This is text after a line break " & "<br>" & _
"This is text on the line" & "<br>" & _
"<b> this is bold text </b> " & "<br>" & _
"<u> this is underlined text </u> " & "<br>" & _
"<b><u> this is bold and underlined text </u></b> " & "<br>" & _
"<i> this is italic text </i> " & "<br>" & _
"<FONT COLOR=RED> this is red text </FONT>" & "<br>" & _
.HTMLBody
' End of With statement
End With
' Release the mail item and application objects
Set OutMail = Nothing
Set OutApp = Nothing
End sub
3. Advanced Level - Outlook email with Excel data range in the email body using a function
By using a (very simple) function, you can embed a table or data series in the body of your email.
Sub envoi_mail_avance()
Dim OutApp As Object
Dim OutMail As Object
Dim plage_mail As Range 'Declare a cell range for the email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set plage_mail = ThisWorkbook.Sheets("mail").Range("A1").CurrentRegion 'Define the cell range for the email
With OutMail
.To = "contact@sap-automation.com"
.Display 'displays the email as a draft in Outlook
'.Send 'sends the email directly
'.Save 'saves the email
.Subject = "Report from: " & Date & " " & Time
.HTMLBody = "Please find the report below," & "<br><br>" & _
RangetoHTML(plage_mail) & "<br><br>" & _
.HTMLBody 'Set the email body in HTML
End With
Set OutMail = Nothing 'Release the mail object
Set OutApp = Nothing 'Release the Outlook application object
End sub
For this macro to work, you need to add the function below in the same module:
Public Function RangetoHTML(rng_mail As Range)
Dim fso As Object 'Declare the file system object
Dim ts As Object 'Declare the text stream object
Dim TempFile As String 'Declare the string variable for the temporary file
Dim TempWB As Workbook 'Declare the temporary workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Define the temporary file path
'Copy the range and create a new workbook to paste the data
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
'Publish the sheet to an htm file
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
'Read all data from the htm file into 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=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file used in this function
Kill TempFile
Set ts = Nothing 'Clean the text stream object
Set fso = Nothing 'Clean the file system object
Set TempWB = Nothing 'Clean the temporary workbook
End Function
4. Advanced Level 2 - Outlook email with chart as attachment
Add a chart as an attachment to the Outlook email.
Sub envoi_mail_graphique()
Dim OutApp As Object 'Declare the Outlook application object
Dim OutMail As Object 'Declare the Outlook mail object
Dim xChartName As String 'Declare a string variable to hold the chart name
Dim xChartPath As String 'Declare a string variable to hold the chart path
Dim xPath As String 'Declare a string variable to hold the path
Dim xChart As ChartObject 'Declare a ChartObject variable to hold the chart object
On Error Resume Next 'Ignore any errors and continue execution
xChartName = "chart" 'Assign the chart name
If xChartName = "" Then Exit Sub 'Exit the sub if the chart name is empty
Set xChart = ThisWorkbook.Sheets("graph").ChartObjects(xChartName) 'Set the chart object to the specified chart on the "graph" sheet
If xChart Is Nothing Then Exit Sub 'Exit the sub if the chart object is not set
Set OutApp = CreateObject("Outlook.Application") 'Create a new instance of Outlook
Set OutMail = OutApp.CreateItem(0) 'Create a new mail item
xChartPath = ThisWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp" 'Set the chart path to current workbook path, current username and current date/time
xChart.Chart.Export xChartPath 'Export the chart to the specified path
With OutMail
.To = "contact@sap-automation.com" 'Set the mail recipient
.Subject = "Chart report from: " & Date & " " & Time 'Set the mail subject
.Attachments.Add xChartPath 'Add the exported chart as attachment
.HTMLBody = "Please find the chart attached." & "<br><br>" & _
.HTMLBody 'Set the mail body
.Display 'Display the email
End With
Kill xChartPath 'Delete the temporary chart file
Set OutMail = Nothing 'Cleanup
Set OutApp = Nothing 'Cleanup
End Sub
5. Expert Level - Outlook email with table and chart in the email body
Add a table and a chart in the body of the Outlook email.
Sub envoi_mail_expert()
Dim OutlookApp As Object 'Declare the Outlook application object
Dim OutlookMail As Object 'Declare the Outlook mail object
Dim consolidationSheet As Worksheet 'Declare the consolidation sheet object
Dim chartObject As chartObject 'Declare the chart object
Dim tableRange As Range 'Declare the range object for the table
Dim chartFilePath As String 'Declare the string variable for the chart file path
Dim tableHTML As String 'Declare the string variable for the table HTML
'Set the consolidation sheet
Set consolidationSheet = ThisWorkbook.Worksheets("CONSOLIDATION")
Set chartObject = consolidationSheet.ChartObjects("chart_example") 'Set the chart object
'Set the table range
Set tableRange = consolidationSheet.ListObjects("CONSOLIDATION").Range
'Save the chart image as a temporary file
chartFilePath = Environ$("temp") & "\chart.jpg"
chartObject.Chart.Export chartFilePath, "JPG"
tableHTML = ConvertRangeToHTML(tableRange) 'Convert the table range to HTML
Set OutlookApp = CreateObject("Outlook.Application") 'Create a new Outlook email
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "contact@sap-automation.com"
.Subject = "Consolidation report from: " & Date & " " & Time
.HTMLBody = .HTMLBody & "<p>Hello, please find below the table and chart of the day:</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>"
'Attach the chart image as an embedded image
.Attachments.Add chartFilePath, 1, 0, "chart.jpg"
.Attachments("chart.jpg").PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", "chart"
.Display 'Display the email (change to .Send to send without displaying)
End With
Kill chartFilePath 'Delete the temporary file
Set OutlookMail = Nothing 'Cleanup
Set OutlookApp = Nothing 'Cleanup
End Sub
For this macro to work, you need to add the function below in the same module:
Function ConvertRangeToHTML(rng As Range) As String
Dim htmlTable As String 'Declare the string variable for the HTML table
Dim row As Range 'Declare the range object for the row
Dim cell As Range 'Declare the range object for the cell
'Start of HTML table
htmlTable = "<thead><tr>"
For Each cell In rng.Rows(1).Cells
htmlTable = htmlTable & "<th>" & cell.Value & "</th>" 'Add each cell from the first row to the table header
Next cell
htmlTable = htmlTable & "</tr></thead><tbody>"
'Add rows and cells to the table
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