Trying to insert picture imagine into email via vba

B

benwork

Board Regular
Joined
Oct 8, 2010
Messages
69
Hi all,

Im trying to send an email of a report with the image attached in the body.

I've got it working but people are having issues when reading the html on their phones so I need it to be an image.

I've tried googling and getting help but I cant get anything

The image is located Sheets("Product compliance").Range("B2:w121")

Any help would be much appreciated. Im pretty green with vba.


Cheers

Ben




Sub email()
'send out the email
Dim Rng As Range, rnga As Range, rngb As Range, rngc As Range
Dim OutApp As Object
Dim OutMail As Object
Dim signature As String
Dim tstamp As String

' report location
Set Rng = Nothing
Set Rng = Sheets("Product compliance").Range("B2:w121")

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
' Subject location
tstamp = Sheets("Save and Send").Range("D5")
With OutMail
.Display
End With
signature = OutMail.HTMLBody

' change change email list here

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = tstamp
.HTMLBody = RangetoHTML(Rng) & _
vbNewLine & signature
.Attachments.Add Sheets("Save and Send").Range("D4") & Sheets("Save and Send").Range("D23") ' attaching the pdf

'.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing

End Sub
 

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.
Sort by date Sort by votes
Hi,

I think this should do what you want:

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("Product compliance").Range("B2:W121")
    
    ''' 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> <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
        .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

The first part
1. Selects your range
2. Pastes it as an image into a chart object
3. Saves the chart object as a temporary .png file

The second part is basically your original macro with the .HTMLBody now changed to embed the previously created image file.
The temporary file is then deleted.
 
Upvote 0
Hi,

I think this should do what you want:

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("Product compliance").Range("B2:W121")
    
    ' 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> <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
        .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

The first part
1. Selects your range
2. Pastes it as an image into a chart object
3. Saves the chart object as a temporary .png file

The second part is basically your original macro with the .HTMLBody now changed to embed the previously created image file.
The temporary file is then deleted.
 
Upvote 0
Thanks Rick for the reply

I tried putting it in and it does bring an image over to the email, but the image is blank

I'm completely out of my depth with this, any ideas?

Cheers

Ben





RickXL said:
Hi,

I think this should do what you want:

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("Product compliance").Range("B2:W121")
    
    ' 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> <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
        .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

The first part
1. Selects your range
2. Pastes it as an image into a chart object
3. Saves the chart object as a temporary .png file

The second part is basically your original macro with the .HTMLBody now changed to embed the previously created image file.
The temporary file is then deleted.
Click to expand...
 
Upvote 0
Hi.

Are you using the code from my second post? It is hard to tell because this message board treats html as formatting instructions and not code. If so, please come back and we will have to do some debugging.

One check you could do would be to comment out the "Kill picFile" near the end then run the code. Afterwards, see if you can find the filed called: TempExportChart.png in your TEMP folder. (I am assuming that you are using Windows?) If you sort your TEMP folder into descending date order then that file will probably be at the top. The next test will be to see if it has data in it or not. If so then the inclusion into the email is failing, if not then the initial copy is failing.

Regards,
 
Upvote 0
Thanks Rick

I am using the second post and I found the file in the temp folder and its blank. It appears the correct size, but just blank white.





RickXL said:
Hi.

Are you using the code from my second post? It is hard to tell because this message board treats html as formatting instructions and not code. If so, please come back and we will have to do some debugging.

One check you could do would be to comment out the "Kill picFile" near the end then run the code. Afterwards, see if you can find the filed called: TempExportChart.png in your TEMP folder. (I am assuming that you are using Windows?) If you sort your TEMP folder into descending date order then that file will probably be at the top. The next test will be to see if it has data in it or not. If so then the inclusion into the email is failing, if not then the initial copy is failing.

Regards,
Click to expand...
 
Upvote 0
OK.

Try stepping through the macro using the F8 key. This will run one instruction per click.

When it gets to the "Set co ..." comand at around line 15 you should see the report blanked out by a white rectangle.

This should be filled back in by the ".Chart.Paste" command.

I am presuming that is not happening?

Can you confirm, please?
 
Upvote 0
Thanks all

I stepped through it and it worked perfectly? I then ran the entire macro and came up with the same issue as before

I run this macro through another macro which had the

Application.ScreenUpdating = False

I moved the ,

Application.ScreenUpdating = True

, before I run the email macro, rather than after, and it worked.

Could you please explain how that would have been the issue?

Thanks again for your help... would have been there for days without it !
 
Upvote 0
Oh, good, I am pleased you have found the problem.

Coincidentally, I added a Application.ScreenUpdating = False to my code at one point and it stopped working as well. So we can be sure that is the problem.

My guess would be that the copy routing uses what the screen actually looks like at the time and not what it could be if it followed the instructions. So if the screen has not updated then there will be nothing to copy.

If you need Application.ScreenUpdating = False then you only need to make sure the screen updates for the
Code: 
r.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
command.

regards,
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA sending an email of two conditions are met
Replies
5
Views
139
mumps
mumps
B
  • Question Question
font size in outlook email (12 points doesn't work)
2
Replies
13
Views
289
basb87
B
K
  • Solved
Macro : Email Worksheet As PDF
Replies
3
Views
420
Domenic
D
C
  • Question Question
VBA to save file to SharePoint and attach to outlook template saved in SharePoint
Replies
1
Views
88
Micron
M
J
  • Question Question
How to make part of my VBA bulk email in bold
Replies
1
Views
394
John_w
J

Forum statistics

Threads
1,223,911
Messages
6,175,324
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top