Home

VBA to email Excel Range as JPG in body

Highlighted
dougs522
Occasional Visitor

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

Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
38 Replies
Extentions Synchronization
Deleted in Discussions on
3 Replies
Stable version of Edge insider browser
HotCakeX in Discussions on
35 Replies
flashing a white screen while open new tab
Deleted in Discussions on
14 Replies
How to Prevent Teams from Auto-Launch
chenrylee in Microsoft Teams on
29 Replies
Security Community Webinars
Valon_Kolica in Security, Privacy & Compliance on
13 Replies