使用VBA将文本和图表复制到Outlook电子邮件中
我正在尝试将工作表中的文本和图表复制/粘贴到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
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
如果您在下一次错误恢复时注释掉
,会发生什么情况?相关:如果我在下一次错误恢复时注释掉,则不会产生明显影响。