I answered a question in stackoverflow today. I really liked the question so I decided to include it here.

As the heading of this post suggests we will try to send an excel range which has images to the body of Outlook email.

Let’s say our Excel Sheet looks like this

Here is a function which will do the needful. I have commented the code so you will not have a problem understanding it.

One more important thing. The range which is being passed to the below function should be in a workbook which is preferably in an empty folder or alternatively ensure that there is no folder called “Temp_Files” in the folder where the excel file resides.


    Option Explicit
    Private Function RngToEmail(rng As Range, eTo As String, eSubject As String)
        Dim wbThis As Workbook, wbNew As Workbook
        Dim tempFileName As String, imgName As String, newPath As String

        '~~ Do not change "Myimg". This will be used to
        '~~ identify the images
        Dim imgPrefix As String: imgPrefix="Myimg"
        '~~ This is the temp html file name.
        '~~ Do not change this as when you publish the
        '~~ html file, it will create a folder Temp_files
        '~~ to store the images
        Dim tmpFile As String: tmpFile = "Temp.Htm"
        Set wbThis = Workbooks(rng.Parent.Parent.Name)
        Set wbNew = Workbooks.Add
        '~~ Copy the relevant range to new workbook
        rng.Copy wbNew.Worksheets("Sheet1").Range("A1")
        newPath = wbThis.Path & "\"
        tempFileName = newPath & tmpFile
        '~~ Publish the image
        With wbNew.PublishObjects.Add(xlSourceRange, _
            tempFileName, "Sheet1", "$A$1:$J$17", xlHtmlStatic, _
            imgPrefix, "")
            .Publish (True)
            .AutoRepublish = True
        End With
        '~~ Close the new file without saving
        wbNew.Close (False)
        '~~ Read the html file in a string in one go
        Dim MyData As String, strData() As String
        Dim i As Long
        Open tempFileName For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1
        strData() = Split(MyData, vbCrLf)
        '~~ Loop through the file
        For i = LBound(strData) To UBound(strData)
            '~~ Here we will first get the image names
            If InStr(1, strData(i), "Myimg_", vbTextCompare) And _
               InStr(1, strData(i), ".Png", vbTextCompare) Then
                '~~ Insert actual path to the images
                strData(i) = Replace(strData(i), _
                                     "Temp_files/", _
                                     newPath & "Temp_files\")
            End If
        Next i
        '~~ Rejoin to get the new html string
        MyData = Join(strData, vbCrLf)
        '~~ Create the Email
        Dim OutApp As Object, OutMail As Object
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = eTo
            .subject = eSubject
            '~~ Set the body
            .HTMLBody = MyData
            '~~ Show the email. Change it to `.Send` to send it
        End With
        '~~ Delete the temp file name
        Kill tempFileName
    End Function


    Sub Sample()
        RngToEmail ThisWorkbook.Sheets("Sheet1").Range("A1:J17"), _
                   "someemail@someserver.com", _
                   "Some Subject"
    End Sub