Writing a macro to copy and paste a range into an Outlook email is what I'm attempting to do. Below the pasted email's pasted range, I want to insert some text and formatting.
Sub sendEmailwithPic()
Dim OutApp As Object
Dim OutMail As Object
Dim table As Range
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'grab table, convert to image, and cut
Set ws = ThisWorkbook.Sheets("Sheet1")
Set table = ws.Range("A1:E11")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut
'create email message
On Error Resume Next
With OutMail
.to = "someone@gmail.com"
.Subject = "Country Population Data " & Format(Date, "mm-dd-yy")
.Display
Set wordDoc = OutMail.GetInspector.WordEditor
wordDoc.Range.PasteandFormat wdChartPicture
.HTMLBody = "<body style=font-size:11pt;font-family:Calibri>" & _
"<p><font style=font-size:11pt;font-family:Calibri><b>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
"sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Vitae ultricies leo integer malesuada nunc.</b></p>" & _
"<p><font style=font-size:9pt;font-family:Calibri>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
"sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.</p>" & _
"<p><font style=font-size:9pt;font-family:Arial;color:#595959><i>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
"sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Amet consectetur adipiscing elit ut. Mattis aliquam faucibus purus in massa tempor." & _
"Hendrerit dolor magna eget est.</i></font></p>" & .HTMLBody
End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
When the macro compiles the email that is displayed looks like this:
However, my desired outcome is this: 
Can someone help me figure out what I'm doing wrong?
