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

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
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

L
  • Question
Combining two codes by Using a Messagebox like Form with yes/no or alike
Replies
1
Views
169
lojanica
L
T
  • Question
VBA- Copy & Paste Range into Outlook as a Picture
Replies
1
Views
271
Domenic
D
The Ruff Report
  • Question
Help adjusting Macro to email multiple cc addresses
Replies
1
Views
440
The Ruff Report
The Ruff Report
A
  • Solved
Sending hyperlink filepath via email
Replies
8
Views
452
AndyEd
A
melodramatic
  • Question
VBA Send Outlook email, Save email to file folder
Replies
3
Views
636
melodramatic
melodramatic

Forum statistics

Threads
1,216,076
Messages
6,128,670
Members
449,463
Latest member
Jojomen56

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