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
