从Office 2013升级到Office 365后,"创建电子邮件"宏停止工作



我的团队最近从Office 2013升级到了Office 365。我们有一个Excel文档,用于自动生成电子邮件,并将发票附加到所述电子邮件中。升级后,它停止工作。

Dim rng As Range
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim StrBody As String
Dim Bundle As Variant, Group As Variant
Bundle = Split(Worksheets("Extra").Range("H2").Value, ",")
StrBody = Range("D5").Value & "<br>" _
& Range("D6").Value & "<br>" _
& Range("D7").Value & "<br>" _
& Range("D8").Value & "<br>" _
& Range("D9").Value
mola = Cells(2, 2).Value
maybe = Format(mola, "mm")
real = Format(mola, "mmmm yyyy")
nope = Format(mola, "yyyy")
InvPath = ("Path omitted for security")

With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
On Error Resume Next
With OutMail
.To = Cells(2, 3).Value
.CC = Cells(2, 4).Value
.Subject = Cells(5, 3).Value
.HTMLBody = StrBody
For Each Group In Bundle
.Attachments.Add InvPath & "Group" & Group & " " & real & ".pdf"
Next
On Error GoTo 0
End With
.Display
With Application
.EnableEvents = True
.ScreenUpdating = True
End With 

提前谢谢--Jsmalls

您还没有明确说明问题所在,所以我假设只要您尝试运行代码,它就会停止。如果是这种情况,请在VB编辑器屏幕(工具、引用(中检查您的引用,并需要确保勾选了Microsoft Outlook 16.0对象库。

Sub test()
Dim rng As Range
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim StrBody As String
Dim Bundle As Variant, Group As Variant
Bundle = Split(Worksheets("Extra").Range("H2").Value, ",")
StrBody = Range("D5").Value & "<br>" _
& Range("D6").Value & "<br>" _
& Range("D7").Value & "<br>" _
& Range("D8").Value & "<br>" _
& Range("D9").Value
mola = Cells(2, 2).Value
maybe = Format(mola, "mm")
real = Format(mola, "mmmm yyyy")
nope = Format(mola, "yyyy")
InvPath = ("Path omitted for security")

With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
On Error Resume Next
With OutMail
.To = Cells(2, 3).Value
.CC = Cells(2, 4).Value
.Subject = Cells(5, 3).Value
.HTMLBody = StrBody
For Each Group In Bundle
.Attachments.Add InvPath & "Group" & Group & " " & real & ".pdf"
.Display
Next
On Error GoTo 0
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

您还可以将.display放在各处,使其与for Each循环的Next位于同一行,并且在任何WithEnd With分组之外。我把它放在For Each循环中,并删除了With分组之外的那个,但你可能想检查一下它应该在哪里。

最新更新