VBA Outlook 在电子邮件到达时采取行动 - 错误处理

Question

我在 Outlook 中有一个 VBA 代码，等待邮件到达 Groupmailbox 来执行某些操作。它运行良好，直到外部资源发生问题为止。它可以毫无问题地处理数千封电子邮件，但与 Exchange 服务器的连接会断开、触发错误并且 VBA 处理停止。 我已经添加到处理子

On Error GoTo endProc
endProc:

希望 VBA 简单地跳过当前电子邮件并继续处理其他电子邮件（这很好），但事实并非如此。此错误只是删除错误本身，但终止 VBA，我必须关闭并打开 Outlook 才能继续常规操作。 尽管遇到种种困难，我如何才能说服 Outlook 继续下去？ 谢谢

Private WithEvents olInboxItems As Items
 
Private Sub Application_Startup()
 Dim objNS As NameSpace
 Set objNS = Application.Session
 Set olInboxItems = GetFolderPath("GROUPMAILBOX\Inbox").Items
 Set objNS = Nothing
 
End Sub
 
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo endProc
     
~some VBA mumbojumbo
 
endProc:

End Sub
 
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
   Dim oFolder As Outlook.Folder
   Dim FoldersArray As Variant
   Dim i As Integer
      
   On Error GoTo GetFolderPath_Error
   If Left(FolderPath, 2) = "\\" Then
       FolderPath = Right(FolderPath, Len(FolderPath) - 2)
   End If
   'Convert folderpath to array
   FoldersArray = Split(FolderPath, "\")
   Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
   If Not oFolder Is Nothing Then
       For i = 1 To UBound(FoldersArray, 1)
           Dim SubFolders As Outlook.Folders
           Set SubFolders = oFolder.Folders
           Set oFolder = SubFolders.Item(FoldersArray(i))
           If oFolder Is Nothing Then
               Set GetFolderPath = Nothing
           End If
       Next
   End If
   'Return the oFolder
   Set GetFolderPath = oFolder
   Exit Function
       
 
GetFolderPath_Error:
   Set GetFolderPath = Nothing
   Exit Function
 
End Function

Answer 1

如果错误被捕获，错误处理程序可以触发

Application_Startup

。

目的是重新初始化

olInboxItems

。

Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()

    Dim folderPath As String
    Dim olFolder As folder
    
    folderPath = "GROUPMAILBOX\Inbox"
    Debug.Print "folderPath: " & folderPath
    
    On Error Resume Next
    Set olFolder = GetFolderPath(folderPath)
    On Error GoTo 0
    
    If Not olFolder Is Nothing Then
        Debug.Print "Found: " & folderPath
        Set olInboxItems = olFolder.Items
    Else
        Debug.Print "Not found: " & folderPath
    End If
        
End Sub


Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

    On Error GoTo endProc
    
    Err.Raise 1
    
    Exit Sub
    
endProc:

    ' A handled error can trigger Application_Startup
    Debug.Print "Err.Number     : " & Err.Number
    Debug.Print "Err.Description: " & Err.Description
    Application_Startup
    
End Sub


Function GetFolderPath(ByVal folderPath As String) As folder

    ' https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
    
    Dim oFolder As folder
    Dim foldersArray As Variant
    Dim i As Long
    
    On Error GoTo GetFolderPath_Error
    If Left(folderPath, 2) = "\\" Then
        folderPath = Right(folderPath, Len(folderPath) - 2)
    End If
    
    'Convert folderpath to array
    foldersArray = Split(folderPath, "\")
    Set oFolder = Session.Folders.Item(foldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(foldersArray, 1)
            Dim subFolders As Folders
            Set subFolders = oFolder.Folders
            Set oFolder = subFolders.Item(foldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function
    
GetFolderPath_Error:
    Set GetFolderPath = Nothing
 
End Function