VBA to email Excel Range as JPG in body

GavinRogers

New Member
Joined
Mar 5, 2019
Messages
1
Hi All,
I am using the following code to select a range in Excel 2016, convert it to JPG and insert into body of email, sending with Outlook 2016.
I am getting responses from recipients that the image is missing from the body of the email.
I have BCC'd myself on the send, and the image shows on my email when received, but testing it to my private outlook.com email has the same result of no image.

Can anyone advise on the issue and rectification?

Sub Send_Email_Store()
Dim TempFilePath As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim xHTMLBody As String
Dim xRg As Range
On Error Resume Next
Set xRg = Sheets("Summary Report").Range("a1:m69")
If xRg Is Nothing Then Exit Sub
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set xOutApp = CreateObject("outlook.application")
Set xOutMail = xOutApp.CreateItem(olMailItem)
Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
TempFilePath = Environ$("temp") & ""
xHTMLBody = "Hi Gav," & "<br>" & _
"Please see the following QTD Summary in your Business, up until last week." & "<br>" & _
"If you have any questions, let me know." _
& "<br><br><br>" _
& "<img src='cid:DashboardFile.jpg'>"
With xOutMail
.Subject = "QTD Overview"
.HTMLBody = xHTMLBody
.Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue, 0
.To = "gavrog@hotmail.com"
.Cc = ""
.Bcc = "me.com"
.Display
End With
End Sub


Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
Dim xRgPic As Range
ThisWorkbook.Activate
Worksheets(SheetName).Activate
Set xRgPic = ThisWorkbook.Worksheets("Summary Report").Range(xRgAddrss)
xRgPic.CopyPicture
With ThisWorkbook.Worksheets("Summary Report").ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "" & nameFile & ".jpg", "JPG"
End With
Worksheets("Summary Report").ChartObjects(Worksheets("Summary Report").ChartObjects.Count).delete
Set xRgPic = Nothing
End Sub
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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