1

I found the solutions to the post very helpful Copy Excel range as Picture to Outlook

However, I hoped someone could help expand on the solution when it comes to using

wdDoc.Range.PasteAndFormat Type:=wdChartPicture in .HTMLBody

I want to paste the picture after "Good Morning, Figures updated in Image below" but before the Table and "Kind Regards":

Public Sub Example()
Dim rng As Range
Dim olApp As Object
Dim Email As Object
Dim Sht As Excel.Worksheet
Dim wdDoc As Word.Document

Set Sht = ActiveWorkbook.Sheets("Summary")
Set rng = Sht.Range("A4:M12")
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

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

Set olApp = CreateObject("Outlook.Application")
Set Email = olApp.CreateItem(0)
Set wdDoc = Email.GetInspector.WordEditor

With Email
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = ""
    .HTMLBody = "Good Morning,<br><br>Figures updated in Image below:<br><br>"

     wdDoc.Range.PasteAndFormat Type:=wdChartPicture

    .HTMLBody = .HTMLBody & "<table>" _
        & "<TH>" & ThisWorkbook.Worksheets("Summary").Range("E14").Value & "</h1>" _
        & "<TH>" & ThisWorkbook.Worksheets("Summary").Range("F14").Value & "</h1>" _
            & "<TR><TD>" & ThisWorkbook.Worksheets("Summary").Range("E15").Value & "</td>" _
            & "<TD>" & ThisWorkbook.Worksheets("Summary").Range("F15").Value & "</td>" _
    & "</table>" _
    & "<br>Kind Regards<br>"

    .Display
End With

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

Set Email = Nothing
Set olApp = Nothing

End Sub
Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343

1 Answers1

0

I changed the range, but the below was found here: http://learnexcelmacro.com/wp/2016/11/send-image-of-a-range-from-excel-embedded-in-mail-inline-image-in-mail/

Option Explicit
Sub SendHTML_And_RangeImage_As_Body_UsingOutlook()
    Dim olApp As Object
    Dim NewMail As Object
    Dim ChartName As String
    Dim imgPath As String
    Dim tmpImageName As String
    Dim RangeToSend As Range
    Dim sht As Worksheet
    Dim objChart As Chart

    'On Error GoTo err

    Set olApp = CreateObject("Outlook.Application")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'define a temp path for your image
    tmpImageName = VBA.Environ$("temp") & "\tempo.jpg"

    'Range to save as an image
    Set RangeToSend = Worksheets("Summary").Range("E14:F15")
    ' Now copy that range as a picture
    RangeToSend.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    ' To save this as an Image we need to do a workaround
    ' First add a temporary sheet and add a Chart there
    ' Resize the chart same as the size of the range
    ' Make the Chart border as Zero
    ' Later once we export that chart as an image
    ' and save it in the above temporary path
    ' will delete this temp sheet

    Set sht = Sheets.Add
    sht.Shapes.AddChart
    sht.Shapes.Item(1).Select
    Set objChart = ActiveChart

    With objChart
        .ChartArea.Height = RangeToSend.Height
        .ChartArea.Width = RangeToSend.Width
        .ChartArea.Fill.Visible = msoFalse
        .ChartArea.Border.LineStyle = xlLineStyleNone
        .Paste
        .Export Filename:=tmpImageName, FilterName:="JPG"
    End With

    'Now delete that temporary sheet
    sht.Delete

   ' Create a new mail message item.
    Set NewMail = olApp.CreateItem(0)

    With NewMail
        .Subject = "Your Subject here" ' Replace this with your Subject
        .To = "abc@email.com" ' Replace it with your actual email

'       **************************************************
'       You can desing your HTML body for this email.
'       below HTML code will display the image in
'       Body of the email. It will not go in attachment.
'       **************************************************
        .HTMLBody = "<body>Dear Sir/Madam, <br><br> Kindly find the report below:<br><br>" & _
        "<img src=" & "'" & tmpImageName & "'/> <br><br> Regards, LearnExcelMacro.com </body>"
        .display

    End With

err:

    'Release memory.
    ' Kill tmpImageName
    Set olApp = Nothing
    Set NewMail = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
W-hit
  • 353
  • 3
  • 14
  • I couldn't get your code to work, a lot of the variables weren't defined so I added DIMs for them. But now I'm getting an error when it gets to the row: Sht.Shapes.AddChart and the error says "Compile error Method or data member not found" – seaside_escape Apr 01 '19 at 12:51
  • Edited it, I'm guessing you declared chart as objChart as the wrong type, so I included it. Try it now. – W-hit Apr 01 '19 at 15:02