Trying to create an Outlook email that has Excel ranges pasted as jpg in the email, along with text before and after. Something like:
Text
Image 1
Image 2
More Text
However, I cannot figure out how to convert Excel ranges to images and paste them in the Outlook email without overriding text there. Current code is below (anonymized), focus on .HTMLBody part. Feels like this should be simple but I can’t figure out the exact code.
Sub GenerateEmail()
' Declare variables
Dim outlookApp As Object
Dim MItem As Object
Dim Recipients As String
Dim Subject As String
Dim Body1 As String
Dim Body2 As String
Dim ws As Worksheet
Dim EmailList As Range
Dim Cell As Range
Dim table1 As Range
Dim table2 As Range
Dim ExcRng As Range
' Set the email subject and body
Subject = "Subject"
Body1 = Sheet1.Range("B11")
Body2 = Sheet1.Range("B12")
' Set the range that includes the list of email addresses
Set EmailList = Sheet1.Range("b11:b11")
' Copy the range as an image and paste it into the email
Set ws = ThisWorkbook.Sheets("sheet1")
Set table1 = ThisWorkbook.Sheets("sheet2").Range("A1:I21")
Set table2 = ThisWorkbook.Sheets("sheet3").Range("A4:W41")
table1.Copy
table2.Copy
' Create a new Outlook email
Set outlookApp = CreateObject("Outlook.Application")
Set MItem = outlookApp.CreateItem(olMailItem)
' Add the recipients, subject, and body to the email
With MItem
.To = ws.Range("G4")
.Subject = ws.Range("B7")
'Add message before ranges
.HTMLBody = ws.Range("B9") & "<br>" & "<br>" & ws.Range("B10") _
**& RangeToJPG(table2) _
& RangeToJPG(table1) _**
& "<br>" & "<br>" & "<br>" & "<br>" & ws.Range("B11")
.Display
End With
Set Message = Nothing
Set Email = Nothing
End Sub
For RangetoJPG I tried using the below code from another user. However, it creates a new email for each image, which I don’t want. I cannot determine how to keep everything within the same Outlook email item.
Function RangeToJPG(rng As Range)
'Copy range of interest
rng.Copy
'Open a new mail item
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim OutMail As Outlook.MailItem
Set OutMail = outlookApp.CreateItem(olMailItem)
'Get its Word editor
OutMail.Display
Dim wordDoc As Word.Document
Set wordDoc = OutMail.GetInspector.WordEditor
'To paste as picture
wordDoc.Range.PasteAndFormat wdChartPicture
End Function