Copy a long excel range to outlook email body as picture - excel

Question

I have been trying to automate an excel daily report including tables and chart into an email body.
I manually select and copy the range and special paste it as a picture into the email body.
I have been trying to automate this part and here's my code:
MailSender = DashboardSheet.Range("S16")
MailDistribution = DashboardSheet.Range("S17")
MailSubject = DashboardSheet.Range("S18")
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(0)
MakeJPG = CopyRangeToJPG("Dashboard", "A1:O8")
If MakeJPG = "" Then
MsgBox "Something go wrong, we can't create the mail"
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Exit Sub
End If
On Error Resume Next
With objOutlookMsg
.SentOnBehalfOfName = MailSender
.To = MailDistribution
.CC = MailSender
.Subject = MailSubject
.Attachments.Add (SentFiles_Pathname & TodaySentReport_Name), 1, 0
.HTMLBody = .HTMLBody & "<p>" & MakeJPG & "</p>" _
& "<img src='" & MakeJPG & "'width='750' height='520'>"
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
MacroBook.Activate
End Sub
Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
Dim PictureRange As Range
With ActiveWorkbook
On Error Resume Next
.Worksheets(NameWorksheet).Activate
Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
If PictureRange Is Nothing Then
MsgBox "Sorry this is not a correct range"
On Error GoTo 0
Exit Function
End If
PictureRange.CopyPicture xlScreen, xlPicture
With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
.Activate
.Chart.Paste
.Chart.Export FileName:="\\server01\DATA\Data Reporting and Dashboard\Dashboard\Daily\" & "NamePicture.jpg", FilterName:="JPG"
End With
.Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
End With
CopyRangeToJPG = "\\server01\DATA\Data Reporting and Dashboard\Dashboard\Daily\" & "NamePicture.jpg"
Set PictureRange = Nothing
End Function
I end up having no picture in the body, just an error message saying:
The linked image cannot be displayed. The file may have been moved, renamed, or deleted. Verify that the link points to the correct file and location.
I then realized that I see no file called NamePicture.jpg in the picture folder. I can't find where the problem comes from.
I am able to add the picture manually to the email body with a copy/special paste but it doesn't work with vba. I tried the solutions I have seen on other related topics, but none works. Has anybody encountered that issue?

Answer 1

See: Embed picture in outlook mail body excel vba
So if you can fix your picture export problem:
'...
.Attachments.Add (SentFiles_Pathname & TodaySentReport_Name), 1, 0
.Attachments.Add MakeJPG, 1, 0 '<#####
.HTMLBody = .HTMLBody & "<p>" & MakeJPG & "</p>" _
& "<img src='cid:NamePicture.jpg' width='750' height='520'>"
'...