Copy Text and Charts into Outlook Email with VBA - vba

Question

I'm trying to copy/paste the text and charts from a worksheet into an Outlook email. This works for the text in the cells, but not the charts (there are currently two charts, but I may add more later). I also noticed that the wEditor object is empty at runtime:
Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim overDueSht As Worksheet
Set overDueSht = Worksheets("Overdue")
lastRowOverDueSht = overDueSht.Cells(Rows.Count, 3).End(xlUp).Row
On Error Resume Next
Set rng = overDueSht.Range("A1", overDueSht.Cells(lastRowOverDueSht, 10))
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "my#email.com"
.CC = ""
.BCC = ""
.Subject = "Overdue Reports"
.HTMLBody = RangetoHTML(rng)
Set wEditor = OutApp.GetInspector.WordEditor
arCharts = Array(1, 2)
For x = 1 To UBound(arCharts)
overDueSht.ChartObjects(arCharts(x)).Activate
ActiveChart.Copy
wEditor.Application.Selection.Start = Len(OutMail.HTMLBody)
wEditor.Paragraphs(1).Range.Paste
wEditor.Application.Selection.End = wEditor.Application.Selection.Start
wEditor.Application.Selection.Paste
Next x
.send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Answer 1

I had similar problem as you and i found out that the remedium is to display message before pasting.
EDIT: Add references: Microsoft Outlook and Microsoft Word. It works for me after changes.
Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim overDueSht As Worksheet
Set overDueSht = Worksheets("Overdue")
lastRowOverDueSht = overDueSht.Cells(Rows.Count, 3).End(xlUp).Row
On Error Resume Next
Set rng = overDueSht.Range("A1", overDueSht.Cells(lastRowOverDueSht, 10))
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = New Outlook.Application
Set OutMail = OutApp.CreateItem(olMailItem)
On Error Resume Next
With OutMail
.To = "my#email.com"
.CC = ""
.BCC = ""
.Subject = "Overdue Reports"
.HTMLBody = "gfdgdsgfds"
.Display
Dim weditor As Word.Document
Set weditor = OutMail.GetInspector.WordEditor
For Each char_t In overDueSht.ChartObjects
char_t.Chart.ChartArea.Copy
weditor.Range(0, 0).Paste
Next
.Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub