使用 Excel VBA 发送邮件时，Outlook 有时会崩溃

Question

我在 Excel 中有 VBA 代码来执行以下操作：

1. 检索订单请求
2. 提取 SAP 报告
3. 验证订单请求
4. 连接到 SAP 进行事务
5. 发送电子邮件
6. 循环（从 #4 开始）直到所有订单都完成

在回复第二封电子邮件时，发送电子邮件部分可能有 15% 的时间崩溃。我可以通过确认以下错误来继续自动化流程，重新启动 Outlook，然后脚本继续运行，就像什么都没发生一样。

我认为这可能是这个特定机器人的内存问题，因为只有这个机器人失败了。我确实理解在代码命中End Sub之后，所有变量都应该从内存中清除。

代码仅用于回复。它在 SAP 事务完成后被调用。

Sub EmailReply()
    
    Application.ScreenUpdating = False
    
    Call OpeningDuties
    
    Dim olApp As Outlook.Application
    Dim oLNameSpace As Outlook.Namespace
    Dim objOwner As Outlook.Recipient
    Dim topOlFolder As Outlook.MAPIFolder
    Dim oLMail As Outlook.MailItem
    Dim i As Long
    Dim wdDoc As Word.Document
    
    Dim EmailAddress As Object
    
    Dim fdr_Unprocessed As Outlook.MAPIFolder
    Dim fdr_Pending As Outlook.MAPIFolder
    Dim fdr_Processed As Outlook.MAPIFolder
    
    Set myNameSpace = Outlook.Application.GetNamespace("mapi")
    Set objOwner = myNameSpace.CreateRecipient("retailrma@company.com")
    objOwner.Resolve
    
    If objOwner.Resolved Then
        Set topOlFolder = myNameSpace.GetSharedDefaultFolder(objOwner, olFolderInbox)
    End If
    
    Set fdr_Unprocessed = topOlFolder.Folders("RMA - Unprocessed")
    Set fdr_Pending = topOlFolder.Folders("RMA - Pending")
    Set fdr_Processed = topOlFolder.Folders("RMA - Processed")
    
    For Each oLMail In fdr_Unprocessed.Items
    
        If (oLMail.Subject = Range("Email_Subject").Text And Format(oLMail.ReceivedTime, "Medium Time") = Format(Range("Email_Date").Text, "Medium Time") And oLMail.SenderEmailAddress = Range("Email_Address").Text) _
          Or (oLMail.Subject = Range("Email_Subject").Text And Format(oLMail.ReceivedTime, "Medium Time") = Format(Range("Email_Date").Text, "Medium Time")) Then
     
            'if email can be found then reply email  or send email
        
            'Define copy range on Email Template sheet as a word document
            Dim CopyRange As Range
        
            'Set wdDoc = oLMail.GetInspector.WordEditor
        
            'Determining if the email should be responded in English or French
            If Range("email_language") = "En" Then
            
                FirstRow = 3
                FirstColumn = 3
                LastRow = 246
                LastColumn = 9
    
            ElseIf Range("email_language") = "Fr" Then
    
                FirstRow = 3
                FirstColumn = 11
                LastRow = 246
                LastColumn = 16
    
            End If
        
            Sheets("Email Template").Select
            Sheets("Email Template").Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn)).AutoFilter Field:=1, Criteria1:="Show"
        
            Set ReplyAll = oLMail.ReplyAll
            Set EmailAddress = Range("Email_Address")
            Set CopyRange = Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn)).SpecialCells(xlCellTypeVisible)
            
            'Error handling if no email address
            If EmailAddress = 0 Then
                RMAStatus = "Non valid email address"
                Application.ScreenUpdating = True
                Exit Sub
            End If
        
            With ReplyAll
                .To = EmailAddress
                .CC = "retailrma@company.com"
                .Display
                .BodyFormat = olFormatHTML
                Set wdDoc = oLMail.GetInspector.WordEditor
                CopyRange.Copy
                wdDoc.Application.Selection.PasteAndFormat Type:=wdFormatOriginalFormatting  'pastes the approved / non approved IMEIs into outlook reply email
                .Send
            End With
        
            'move email to processed folder
            oLMail.Move fdr_Processed
        
            'Resets Email Template
            Sheets("Email Template").Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn)).AutoFilter Field:=1
        
            GoTo ExitSendEmail
        
        End If
        
    Next oLMail
    
ExitSendEmail:
    
    Application.ScreenUpdating = True
    
End Sub

Answer 1

首先，确保在代码中正确定义了所有对象：

Dim oLNameSpace As Outlook.Namespace

但在后面的代码中使用了另一个对象：

 Set myNameSpace = Outlook.Application.GetNamespace("mapi")

另一个可能的薄弱环节是用于编辑电子邮件的 Word 对象模型。

Set wdDoc = oLMail.GetInspector.WordEditor

尝试改用MailItem 类的HTMLBody 属性。

您还可以在每次迭代之间添加延迟。有关详细信息，请参阅Timer 函数。以下示例使用Timer 函数暂停应用程序。该示例还使用DoEvents 在暂停期间让步给其他进程。

Dim PauseTime, Start, Finish, TotalTime
If (MsgBox("Press Yes to pause for 5 seconds", 4)) = vbYes Then
    PauseTime = 5    ' Set duration.
    Start = Timer    ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop
    Finish = Timer    ' Set end time.
    TotalTime = Finish - Start    ' Calculate total time.
    MsgBox "Paused for " & TotalTime & " seconds"
Else
    End
End If