Sending a chart in mail body

Question

I'm trying to modify Ron de Bruin's code to send a chart in mail body.

I export the chart and save it as an PNG image, then I modify HTML code to add it to the message.

The code should run on a server and send mails to people in my workplace.

When using MailItem.Display and manually clicking "send" when my message appears, everything works.
When I try to use MailItem.Send I get an icon in the mail body like it tried to attach an image which it couldn't find.

When I send that mail from a server, on a server account, the chart is displayed correctly.
It doesn't work when I try to send it on "local" computers.

Sub wyslij()

    NameOfThisFile = ActiveWorkbook.Name
    
    Dim rng As Range
    Dim dataminus1, dataminus2 As Date
    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")
    
    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)
    
    Set rng = Nothing
    Set rng = Sheets(2).Range("E1:P13")
    
    olMail.To = "xxx@xxx" 
    olMail.CC = "xxxx@xxx"
    olMail.Subject = "xxxx"
    olMail.HTMLBody = RangetoHTML(rng)
    olMail.Display
    'olMail.Send
    
    'Delete file after sending a mail
    'Call DeleteFile(Path)
    
End Sub
    
Sub Save_ChartAsImage()
    
    ChartEx = False
    
    Dim cht As ChartObject
    
    For Each cht In ActiveSheet.ChartObjects
        If cht.TopLeftCell.Column = ChartCol And cht.TopLeftCell.Row = ChartRow Then
            ChartEx = True
            On erRROR GoTo Err_Chart
            cht.Chart.Export Filename:=ActiveWorkbook.Path & "\Chart.png", Filtername:="PNG"
        End If
    Next cht
    
Err_Chart:
    If Err <> 0 Then
        Debug.Print Err.Description
        Err.Clear
    End If
End Sub

Function RangetoHTML(rng As Range)

    ' Changed by Ron de Bruin 28-Oct-2006
    ' Working in Office 2000-2013
    
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        '.Cells(1).PasteSpecial xlPasteAll
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
    
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    
    'kopiujemy wykres z poprzedniego działu
    'Workbooks("WplatyFinal.xlsm").Activate
    Workbooks(NameOfThisFile).Activate
    Call Save_ChartAsImage
    
    TempWB.Activate
    TempWB.Sheets(1).Select
    
    'Publish the sheet to a 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
    
    If ChartEx Then
        RangetoHTML = RangetoHTML & "<img src ='" & ActiveWorkbook.Path & "\Chart.png" & "'>"
    End If
        
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    
    'Close TempWB
    TempWB.Close savechanges:=False
    
    'Delete the htm file we used in this function
    Kill TempFile
    
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

I tried to use the Wait function directly after the Send method.

the email works just like a web page, when you include an `` tag, you're just sending a reference to the path set in `src`. If the computer receiving the email cannot access that path, then the image will not appear. you need to save the images somewhere public, and leave them there for this to work. — WhiteHat, Dec 08 '15 at 18:29
But it works fine when i use olMail.Display and then click "send". By clicking send do I make an image an integral part of a mail? There must be a way to add an image to a body of a mail, so that receiver doesnt have to have acces to source of an image to display it properly... — HalfTimeDreamer, Dec 08 '15 at 19:15
How to do it then (in a body of a mail, not as an attachement)? I thought I do it right. — HalfTimeDreamer, Dec 08 '15 at 19:23
I had this issue in the past (sorry don't have the code I used to fix it), but I believe I saved it as a picture, then attached the picture... or something close to that. — Scott Holtzman, Dec 08 '15 at 19:24
you can use [base64](http://stackoverflow.com/questions/16449445/how-can-i-set-image-source-with-base64) to include the actual content of the image on the page, otherwise, the path must be available. see also [Convert image (jpg) to base64](http://stackoverflow.com/a/8134022/5090771) — WhiteHat, Dec 08 '15 at 19:34

score 4 · Accepted Answer · edited Feb 04 '22 at 14:16

Getting the images to appear as inline is certainly possible. The img src in the HTML must refer to the cid with an identifier for the image. The code below sets up the email and adds all of the chart objects as inline images to an email.

    Option Explicit
    
    Sub CreateEmail()
        Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
        Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim olApp As Object
        Dim olMail As Object
        Dim msg As String
        Dim msgGreeting As String
        Dim msgPara1 As String
        Dim msgEnding As String
        Dim chrt As ChartObject
        Dim fname As String
        Dim ident As String
        Dim tempFiles As Collection
        Dim imgIdents As Collection
        Dim imgFile As Variant
        Dim attchmt As Object
        Dim oPa As Object
        Dim i As Integer
        
        '--- create the email body with HTML-formatted content
        msgGreeting = "<bold>Dear Sirs</bold>,<br><br>"
        msgPara1 = "<div>Here is the data you requested:</div>"
        msgEnding = "<br><br>Sincerely,<br>JimBob<br>"
        
        '--- build the other email body content
        Set wb = ActiveWorkbook
        Set ws = ActiveSheet
        msg = msgGreeting & msgPara1
        '--- loops and adds all charts found on the worksheet
        If ws.ChartObjects.Count > 0 Then
            Set tempFiles = New Collection
            Set imgIdents = New Collection
            For Each chrt In ws.ChartObjects
                fname = ""
                msg = msg & ChartToEmbeddedHTML(chrt, fname, ident) & "<br><br>"
                tempFiles.Add fname
                imgIdents.Add ident
            Next chrt
        End If
        msg = msg & msgEnding
        
        '--- create the mail item
        Set olApp = CreateObject("Outlook.Application")
        Set olMail = olApp.CreateItem(0)                'olMailItem=0
        With olMail
            .To = "yyy@zzzz.com"
            '.CC = "xxxx@xxx"
            .Subject = "xxxx"
            .bodyformat = 2        'olFormatHTML=2
            '--- each of the images is referenced as a filename, but each one must be
            '    individually added as an attachment, then the attachment properties
            '    set to show the attachment as "inline". Because the image will be
            '    inlined, we'll use the "ident" as the reference (internal to the
            '    message body HTML)
            If (Not tempFiles Is Nothing) Then
                For i = 1 To tempFiles.Count
                    Set attchmt = .attachments.Add(tempFiles.Item(i))
                    Set oPa = attchmt.PropertyAccessor
                    oPa.SetProperty PR_ATTACH_MIME_TAG, "image/png"
                    oPa.SetProperty PR_ATTACH_CONTENT_ID, imgIdents.Item(i)
                Next i
            End If
            '--- the email item needs to be saved first
            .Save
            '--- now add the message contents
            .htmlbody = msg
            .display
        End With
        '--- delete the temp files now
        For Each imgFile In tempFiles
            Kill imgFile
        Next imgFile
        '--- clean up and get out
        Set tempFiles = Nothing
        Set imgIdents = Nothing
        Set attchmt = Nothing
        Set oPa = Nothing
        Set olMail = Nothing
        Set olApp = Nothing
        Set ws = Nothing
        Set wb = Nothing
    End Sub
    
    Private Function ChartToEmbeddedHTML(thisChart As ChartObject, _
                                 ByRef tmpFile As String, _
                                 ByRef ident As String) As String
        Dim html As String
        ident = RandomString(8)
        tmpFile = thisChart.Parent.Parent.Path & "\" & ident & ".png"
        
        thisChart.Activate
        thisChart.Chart.Export Filename:=tmpFile, Filtername:="png"
        html = "<img alt='Excel Chart' src='cid:" & ident & "'></img>"
        ChartToEmbeddedHTML = html
    End Function
    
    Private Function RandomString(strlen As Integer) As String
        Dim i As Integer, iTemp As Integer, bOK As Boolean, strTemp As String
        '48-57 = 0 To 9, 65-90 = A To Z, 97-122 = a To z
        'amend For other characters If required
        For i = 1 To strlen
            Do
                iTemp = Int((122 - 48 + 1) * Rnd + 48)
                Select Case iTemp
                Case 48 To 57, 65 To 90, 97 To 122: bOK = True
                Case Else: bOK = False
                End Select
            Loop Until bOK = True
            bOK = False
            strTemp = strTemp & Chr(iTemp)
        Next i
        RandomString = strTemp
    End Function

Thanks a lot guys! I found the way how to do it today at work at this site: http://excel-macro.tutorialhorizon.com/excel-vba-send-mail-with-embedded-image-in-message-body-from-ms-outlook-using-excel/ and it works! It's the same solution as you proposed in your answer. But do you know maybe why displaying mail and the sending it works, even with path to an image on your local hard drive? — HalfTimeDreamer, Dec 10 '15 at 16:40
Adding the images as attachments first and setting the properties for the `TAG` and `CONTENT_ID` (and then saving the email), are the steps that embed the image in the email body. Those images are now "copied" into the email body. Adding the HTML message contents at this point makes the connection between the message body display and the image data -- using the `ident` tag as the link between the body and the embedded image. This is why the temporary images are deleted in the code after this step, because they're already copied into the email. — PeterT, Dec 10 '15 at 16:51

score 0 · Answer 2 · answered Aug 02 '18 at 11:18

Excellent! I couldn't manage to attach the active workbook into the mail. I tried to add the code .Attachments.Add (ActiveWorkbook.FullName) but didn't work, I received a message saying that the file is in use, and sometimes Runtime error 424 - Object required

With olMail
    .To = "yyy@zzzz.com"
    '.CC = "xxxx@xxx"
    .Subject = "xxxx"
    .Attachments.Add (ActiveWorkbook.FullName) ' this i added

Sending a chart in mail body

2 Answers2