Creating and copying Excel chart to Outlook works line by line but not when run

Question

When I run the code the chart is not created properly and it pastes a blank image into the email. When I step line by line it is fine.

Sub SendRangeScreenshotByEmail()
    ' Define variables
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim rng As Range
    Dim tempChart As ChartObject
    Dim base64Image As String

    ' Set the range to be captured
    Set rng = ThisWorkbook.Sheets("SUM TREND").Range("A1:U34")

    ' Create a new chart sheet to paste the picture
    Set tempChart = Sheets.Add(After:=Sheets(Sheets.Count)).ChartObjects.Add(Left:=10, Width:=1400, Top:=75, Height:=600)

    ' Copy the range as a picture to the chart
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    tempChart.chart.Paste

    ' Convert the chart to a Base64-encoded image
    base64Image = ChartToBase64(tempChart.chart)

    ' Create a new Outlook Application
    Set outlookApp = CreateObject("Outlook.Application")
    
    ' Create a new email
    Set outlookMail = outlookApp.CreateItem(0)

    ' Add a subject and recipient
    outlookMail.Subject = "Screenshot of Range"
    outlookMail.To = "email@email.com"

    ' Attach the Excel file
    outlookMail.Attachments.Add ThisWorkbook.FullName

    ' Add the screenshot to the email body as an embedded image
    outlookMail.HTMLBody = "<p><img src='data:image/png;base64," & base64Image & "'></p>"

    ' Display the email
    outlookMail.Display

    ' Clean up (delete the temporary chart)
    Application.DisplayAlerts = False
    tempChart.Delete
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Delete
    Application.DisplayAlerts = True
End Sub
Function ChartToBase64(chart As chart) As String
    ' Convert chart image to Base64
    Dim tempChart As ChartObject
    Set tempChart = chart.Parent

    ' Export the chart area as a temporary image file
    Dim tempFilePath As String
    tempFilePath = Environ$("temp") & "\" & "ChartTempImage.png"
    tempChart.chart.Export Filename:=tempFilePath, FilterName:="PNG"

    ' Read the image file as Base64
    ChartToBase64 = FileToBase64(tempFilePath)

    ' Delete the temporary image file
    Kill tempFilePath
End Function


Function FileToBase64(filePath As String) As String
    ' Convert a file to Base64
    Dim objXML As Object
    Dim objNode As Object

    ' Read the file as binary and encode it to Base64
    Set objXML = CreateObject("MSXML2.DOMDocument.6.0")
    objXML.Load (filePath)

    Set objNode = objXML.CreateElement("b64")
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = GetBytes(filePath)
    
    FileToBase64 = objNode.Text
End Function

Function GetBytes(filePath As String) As Variant
    ' Read the file as binary
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")

    objStream.Open
    objStream.Type = 1 ' Binary
    objStream.LoadFromFile filePath

    GetBytes = objStream.Read
    objStream.Close
End Function

I tried Application.Wait and DoEvents on various lines. I thought wait would work, because when I clicked through the code in step by step mode too fast it was making blank emails too.

When I put the wait after the line which makes the temp chart, it made the chart but looked like it was not loading properly, so I tried loops.

Answer 1

This works consistently for me:

Sub SendRangeScreenshotByEmail()
    ' Define variables
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim rng As Range
    Dim tempChart As ChartObject
    Dim base64Image As String, t

    Set rng = ThisWorkbook.Sheets("SUM TREND").Range("A1:U34")
    'adding chart on same sheet...
    Set tempChart = rng.Worksheet.ChartObjects.Add( _
       Left:=rng.Left + rng.Width + 20, Width:=1400, Top:=10, Height:=600)
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    t = Timer + 0.5     'add a 0.5 sec delay here
    Do While Timer < t
        DoEvents
    Loop
    
    tempChart.chart.Paste
    base64Image = ChartToBase64(tempChart.chart)

    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)
    outlookMail.Subject = "Screenshot of Range"
    outlookMail.To = "email@email.com"
    outlookMail.Attachments.Add ThisWorkbook.FullName
    outlookMail.HTMLBody = "<p><img src='data:image/png;base64," & base64Image & "'></p>"
    outlookMail.Display

    ' Clean up (delete the temporary chart)
    Application.DisplayAlerts = False
    tempChart.Delete
    Application.DisplayAlerts = True
End Sub

Without the delay I was getting the same blank emails...