Email as Picture VBA not working correctly

burns14hs

Board Regular
Joined
Aug 4, 2014
Messages
76
Hello All -

I have this bastardized code that i've taken from a couple places and squeezed together to create what I needed to get a range emailed out as a picture. Unfortunately I cannot share the file but here's the general problem. As I step through the code it does everything I want it to do as it make a picture and then adds it to an email. If I push play and run the code, I get a blank box the size of the picture I'm supposed to have. Any help on why this works as a step through and not in full speed?

VBA Code:
Sub dockMail()

Dim str$
str = ""
'
For x = 24 To 21 Step -1
'
If Sheets("Wash").Range("B" & x).Value <> "" Then
str = Sheets("Wash").Range("B" & x) & "@amazon.com; " & str
End If
'
Next x
    
    '===================================================
    ' 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("Wash").Range("J1:AF62")
    
    ''' 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("Save and Send").Range("D5")
    OutMail.display
    signature = OutMail.HTMLBody
    
    ' change change email list here
    strBody = "<body> <img src=""" & picFile & """ style=""width:304px;height:228px""></body>"
    
    On Error Resume Next
    With OutMail
        .To = str
        .CC = ""
        .BCC = ""
        .Subject = "MKE2 imPaCtFul " & Sheets("Wash").Range("E11").Value & " Wash - " & Sheets("Wash").Range("T1").Value
        .HTMLBody = strBody & vbNewLine & signature
'        .Attachments.Add Sheets("Save and Send").Range("D4") & Sheets("Save and Send").Range("D23") ' attaching the pdf
    End With
    Kill picFile
    On Error GoTo 0
    
    'Tidy Up
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set co = Nothing
    Set r = Nothing

End Sub
 

Some videos you may like

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,868
Office Version
  1. 2013
Platform
  1. Windows
As I understand it the picture should be attached and the body references the attached file name using '<img src=cid: filename>'.
Not tried it with style addition before.
Something like;

Code:
strBody = "<body> <img src=""cid:TempExportChart.png"" style=""width:304px;height:228px""></body>"

.Attachments.Add picfile
 

burns14hs

Board Regular
Joined
Aug 4, 2014
Messages
76
As I understand it the picture should be attached and the body references the attached file name using '<img src=cid: filename>'.
Not tried it with style addition before.
Something like;

Code:
strBody = "<body> <img src=""cid:TempExportChart.png"" style=""width:304px;height:228px""></body>"

.Attachments.Add picfile
Still getting just the empty box on run, but now have an empty box attachment as well. If I step through it generates the actual picture for both, just like before. It's almost like it's doing the actions too quickly in this section to generate the picture but it has enough time when I step through line by line to generate properly:
VBA Code:
    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 Wit

I have tried breaking that section up with wait commands without success as well.
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,403
It's almost like it's doing the actions too quickly in this section to generate the picture but it has enough time when I step through line by line to generate properly

It's probably what's happening. One way to work around this issue is to activate the chartobject before pasting...

VBA Code:
    Set co = r.Parent.ChartObjects.Add(Left:=r.Left, Top:=r.Top, Width:=r.Width, Height:=r.Height)
    With co
        .Activate
        ''' Paste into chart area, export to file, delete chart.
        .Chart.Paste
        .Chart.Export picFile
        .Delete
    End With

Hope this helps
 
Solution

burns14hs

Board Regular
Joined
Aug 4, 2014
Messages
76
It's probably what's happening. One way to work around this issue is to activate the chartobject before pasting...

VBA Code:
    Set co = r.Parent.ChartObjects.Add(Left:=r.Left, Top:=r.Top, Width:=r.Width, Height:=r.Height)
    With co
        .Activate
        ''' Paste into chart area, export to file, delete chart.
        .Chart.Paste
        .Chart.Export picFile
        .Delete
    End With

Hope this helps
Amazing sir... this fixed it. Thank you so much
 

Watch MrExcel Video

Forum statistics

Threads
1,118,775
Messages
5,574,159
Members
412,574
Latest member
shadowfighter666
Top