I have a VBA code in outlook waiting for mail arrive to Groupmailbox to do something. It works well, until something bad happen on external resources. It process thousands of emails without any problem, than connection to exchange server drops, error is triggered and VBA processing stops.
I have added into processing sub
On Error GoTo endProc
endProc:
Hoping that VBA simply skips current email and continue with processing other one (which is fine), but not. This On Error just remove the error itself, but terminate VBA and I have to turn off and on outlook to continue usual operations.
How can I convince outlook to continue despite of all troubles?
Thanks
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
Set olInboxItems = GetFolderPath("GROUPMAILBOXInbox").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
5
If the error is caught the error handler can trigger Application_Startup.
The intent is to reinitialize olInboxItems.
Option Explicit
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim folderPath As String
Dim olFolder As folder
folderPath = "GROUPMAILBOXInbox"
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