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 .Display End With '~~ Delete the temp file name Kill tempFileName End Function
Usage:Sub Sample() RngToEmail ThisWorkbook.Sheets("Sheet1").Range("A1:J17"), _ "firstname.lastname@example.org", _ "Some Subject" End Sub