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