Insert PivotTable (in Email Body) | Excel VBA Macro

Excel VBA Macro: Insert PivotTable (in Email Body)
💥Subscribe: / @greggowaffles
Code:
Sub send_email_with_pivot_table()
Dim OutApp As Object
Dim OutMail As Object
Dim table As PivotTable
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set ws = ThisWorkbook.Sheets("Pivot Sheet")
Set table = ws.PivotTables("PivotTable1")
ws.Activate
table.TableRange2.Copy
Set pic = ws.Pictures.Paste
With pic
.Select
.Cut
End With
'create email message
On Error Resume Next
With OutMail
.to = "[e-mail]"
.CC = ""
.BCC = ""
.Subject = "Country Population Data " & Format(Date, "mm-dd-yyyy")
.display
Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.pasteandformat wdChartPicture
.insertParagraphafter
.insertParagraphafter
.InsertAfter "Thank you,"
.insertParagraphafter
.InsertAfter "Greg"
End With
.HTMLBody = "＜Body style = font-size: 12pt; font-family: Arial＞ " & _
"Hi Team, ＜p＞ Please see table below: ＜p＞ " & .HTMLBody
End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
#excelmacro #excelvba

[@iamgaile7180]

Hi sir, thank you so much for this video. Is it possible to paste more than 1 pivot table to outlook?

[@GGPG]

hi sir, i came acrros your video, very help, but how do i change the size of the image pasted on the email please?? hope you can answer my question

[@ma.cedezcatherinemalijan2200]

Hello! I need this same function but not using pivot. I need to copy and paste a certain range from excel to outlook. Please help