Send HTML email with embedded Images

The following article explains how to send an email in VBA with embedded images in the body. The code works with all Microsoft Office Suite (including Office 2013).

Let's consider an Excel file with a 'Dashboard' sheet as this screenshot :

The code detailed after automatically creates a 'ready to send' email in outlook :

First we create an outlook mail object, then, we write the mail body (in html). Please note following points :
    - embedded images must be save on your computer (as a jpg file or png file) ;
    - Since outlook 2013, embedded images must be attached to the email as well.

Sub sendMail()
        Application.Calculation = xlManual
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        Dim TempFilePath As String
        
        'Create a new Microsoft Outlook session
        Set appOutlook = CreateObject("outlook.application")
        'create a new message
        Set Message = appOutlook.CreateItem(olMailItem)
          
        
        With Message
            .Subject = "My mail auto Object"
    
            .HTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello,<br ><br >The weekly dashboard is available " _
                & "<br>Find below an overview :<BR>"
               
            'first we create the image as a JPG file
            Call createJpg("Dashboard", "B8:H9", "DashboardFile")
            'we attached the embedded image with a Position at 0 (makes the attachment hidden)
            TempFilePath = Environ$("temp") & "\"
            .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue, 0
               
            'Then we add an html <img src=''> link to this image
            'Note than you can customize width and height - not mandatory
               
            .HTMLBody = .HTMLBody & "<br><B>WEEKLY REPPORT:</B><br>" _
                & "<img src='cid:DashboardFile.jpg'" & "width='814' height='33'><br>" _
                & "<br>Best Regards,<br>Ed</font></span>"
                
            .To = "contact1@email.com; contact2@email.com"
            .Cc = "contact3@email.com"
                
            .Display
            '.Send
        End With
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        Application.Calculation = xlCalculationAutomatic
    End Sub

You need to create createJpg function which transform a range into a jpg file.

Sub createJpg(Namesheet As String, nameRange As String, nameFile As String)
    ThisWorkbook.Activate
    Worksheets(Namesheet).Activate
    Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
    Plage.CopyPicture
    With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
Set Plage = Nothing
End Sub

You can download my template file here (untick Use our download manager and get recommended downloads)