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

Question

I have VBA code in Excel to perform the following actions:

1. retrieve order request
2. pull SAP reports
3. validate order request
4. connect to SAP to do transaction
5. send email
6. loop (from #4) until all orders are done

The sending email part crashes probably 15% of the time on replying to the second email. I can continue the automation flow by acknowledging the below error, restart Outlook, and the script continues like nothing happened.

I'm thinking that it might be a memory issue with this particular bot as it's only this one that fails. I do comprehend that after the the code hits End Sub , then all the variables should be cleared from memory.

The code is only for replying. It gets called after the SAP transaction is done.

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

First of all, make sure that all objects are defined correctly in the code:

Dim oLNameSpace As Outlook.Namespace

But later in the code another object is used:

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

Another possible weak area is a Word object model used for editing emails.

Set wdDoc = oLMail.GetInspector.WordEditor

Try to use the HTMLBody property of the MailItem class instead.

Also you may add a delay between each iteration. See the Timer function for more information. The following example uses the Timer function to pause the application. The example also uses DoEvents to yield to other processes during the pause.

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