How can I add a worksheet into email body as image?

Question

As I asked before in another thread Paste specific worksheet range into email body, I'm trying to include a custom worksheet into the e-mail body using Ron's VBA code with some modifications as I posted below:

Sub Enviar_Abertura()

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim MakeJPG As String

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
          
MakeJPG = CopyRangeToJPG("E-MAIL ABERTURA", "B6:F27")

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 OutMail
    .SentOnBehalfOfName = "teste@teste.com.br"
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = Planilha5.Range("B4")
    .Attachments.Add MakeJPG, 1, 0
    .HTMLBody = "<html><p>" & strbody & "</p><img src=""cid:NamePicture.jpg""></html>"
    .Display
End With
On Error GoTo 0

Kill MakeJPG

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
'Ron de Bruin, 25-10-2019
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
    With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg", "JPG"
    End With
    .Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
End With

CopyRangeToJPG = Environ$("temp") & Application.PathSeparator & "NamePicture.jpg"
Set PictureRange = Nothing
End Function

So, basically the macro is working properly to invoke Microsoft Outlook new message, make an image from the specific range of the worksheet and paste it into the body of the new message.

But when I make a test and send the message to me and a colleague, the image is not shown as expected for receivers. Below are some screenshot that I took from the scenario.

New message being invoked

Received on Microsoft Outlook

Received on Outlook Web

So guys, could someone help me to solve this issue please?

https://stackoverflow.com/questions/16143877/using-vba-code-how-to-export-excel-worksheets-as-image-in-excel-2003 — braX, Jun 14 '23 at 23:17
Hello @TimWilliams, did you received the message with the image into the body? I tested this code with me and a colleague and we received the same error as I posted into the thread. The image does not load for the receivers. — Gulkas, Jun 14 '23 at 23:55

Davesexcel · Accepted Answer · 2023-06-15T07:43:11.583

Keep it simple.

Copy a picture of the range to outlook

    Sub CopyRngToOutlook()
    Dim doc As Object, rng As Range
    Set rng = Sheets("Sheet1").Range("B6:F27")
    With CreateObject("Outlook.Application").CreateItem(0)
        .Display
        Set doc = .GetInspector.WordEditor
        rng.CopyPicture
        doc.Range(0, 0).Paste
        .To = "someone@somewhere.com"
        .Subject = "Send Email Body"
        .send
    End With
End Sub

If you wanted to send additional text:

    Sub CopyRngToOutlook2()
    Dim doc As Object, rng As Range
    Set rng = Sheets("Sheet1").Range("B6:F27")
    With CreateObject("Outlook.Application").CreateItem(0)
        .Display
        Set doc = .GetInspector.WordEditor
        x = doc.Range.End - 1
        doc.Range(x) = "Hello There" & vbNewLine & vbNewLine & vbNewLine
        x = doc.Range.End - 1
        rng.CopyPicture
        doc.Range(x).Paste
        .To = "someone@somewhere.com"
        .Subject = "Send Email Body"
        '.send
    End With
End Sub

Another sample of pasting ranges

I used the simple code that you shared Davesexcel, but I'm making 3 different announcements and the difference between these announcements are the quantity of lines. The width should be the same on 3, but when I use your code, I'm seeing a width diference between the images. This difference does not exist into Excel as I copied the first one to make the other two. So, is there anyway to keep the measurements of Excel when it copies to Outlook? — Gulkas, Jun 15 '23 at 22:44
I found a way, just added xlScreen, xlBitmap to rng.CopyPicture expression, and then it was like: rng.CopyPicture xlScreen, xlBitmap — Gulkas, Jun 15 '23 at 23:10

How can I add a worksheet into email body as image?

1 Answers1

Linked