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 = "email@example.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