使用VBA将文本和图表复制到Outlook电子邮件中

使用VBA将文本和图表复制到Outlook电子邮件中,vba,Vba,我正在尝试将工作表中的文本和图表复制/粘贴到Outlook电子邮件中。这适用于单元格中的文本,但不适用于图表(目前有两个图表,但稍后我可能会添加更多)。我还注意到wEditor对象在运行时是空的: Sub Mail_Selection_Range_Outlook_Body() Dim rng As Range Dim OutApp As Object Dim OutMail As Object Dim overDueSht As Worksheet Set overDueSht = Works

我正在尝试将工作表中的文本和图表复制/粘贴到Outlook电子邮件中。这适用于单元格中的文本,但不适用于图表(目前有两个图表,但稍后我可能会添加更多)。我还注意到
wEditor
对象在运行时是空的:

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

我遇到了与您类似的问题,我发现补救措施是在粘贴之前显示消息

编辑:添加引用:Microsoft Outlook和Microsoft Word。改变后对我有用

    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

如果您在下一次错误恢复时注释掉
,会发生什么情况?相关:如果我在下一次错误恢复时注释掉
,则不会产生明显影响。