Copy a long excel range to outlook email body as picture

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?

Comment out the `On Error Resume Next` and see what happens when you run your code. — Tim Williams, Jul 28 '21 at 17:07
Thanks for your reply. Nothing happens (I also ran it with break points). I mean the procedure just go smoothly. As if everything went well except that no jpg file is created and no picture is showing up in the email body. It's really strange. — Manu Lo, Jul 28 '21 at 18:17

score 0 · Answer 1 · answered Jul 28 '21 at 20:08

0

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'>"
'...

answered Jul 28 '21 at 20:08

Tim Williams

154,628
8
97
125

I had actually checked that link before posting. I think the problem is a rare one. I tested the function part on it's own with a dummy test file and it worked. Maybe it's how I enter the range MakeJPG = CopyRangeToJPG("Dashboard", "A1:O8")? Excel can be so frustrating sometimes! – Manu Lo Jul 29 '21 at 16:51
That `CopyRangeToJPG` method works fine for me when I tested. It would be better to pass in a Range object though, instead of a worksheet name and range address - that's a little "indirect" and potentially opens you up to odd bugs. – Tim Williams Jul 29 '21 at 17:07
Ah yes I forgot about the Range object. I will change it thank you Tim. – Manu Lo Jul 29 '21 at 18:03
I actually figured it out. It was because the range I was using, was protected -_-'. It works fine now. I didn't add that part of the code thinking the problem wasn't there. – Manu Lo Jul 29 '21 at 18:05

Copy a long excel range to outlook email body as picture

1 Answers1