Pasting Range as Image to Outlook

[AKing1985]

Howdy,

I'm trying to paste a selected range as an image to an email via VBA a la this post. I have the code working, for the most part. However, the image that gets pasted is blank. If I single step with F8, the code works, but when I run it like normal, it's blank. I'm completely lost as to why it works when done step-by-step, but not automatically. Here's my full code:

Sub email()        
    '===================================================
    ' Export Range as PNG file
    '===================================================
    ' Set Range you want to export to file
    Dim r As Range
    Dim co As ChartObject
    Dim picFile As String
    Set r = Worksheets("Notification").Range("A1:D17")
       
    ' Copy range as picture onto Clipboard
    r.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    picFile = Environ("Temp") & "\TempExportChart.png"
    
    ' Create an empty chart with exact size of range copied
    Set co = r.Parent.ChartObjects.Add(Left:=r.Left, Top:=r.Top, Width:=r.Width, Height:=r.Height)
    With co
        ' Paste into chart area, export to file, delete chart.
        .Chart.Paste
        .Chart.Export picFile
        .Delete
    End With
    


    '===================================================
    ' Create Email and Import Picture
    '===================================================
    ' Send out the email
    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")
    Dim OutMail As Object
    Set OutMail = OutApp.CreateItem(olMailItem)
    
    Dim signature As String
    Dim tstamp As String
    Dim strBody As String
    
    ' Subject location
    tstamp = Sheets("Notification").Range("B21")
    OutMail.Display
    signature = OutMail.HTMLBody
    
    ' Change change email list here
    strBody = "******> <h2>Report</h2> <img src=""" & picFile & """ style=""width:304px;height:228px""></body>"
    
    On Error Resume Next
    With OutMail
        .To = "xxx@yyy.com"
        .CC = ""
        .BCC = ""
        .Subject = tstamp
        .HTMLBody = strBody & vbNewLine & signature
    End With
    On Error GoTo 0
    
    'Tidy Up
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set co = Nothing
    Set r = Nothing
End Sub

 

[John_w]

Excel 2016? It seems that Microsoft broke something with the Chart object because this is a common problem in that version. To fix, add ".Activate", without the quotes, above the .Chart.Paste line.