vbaoutlookoutlook-2003

Run-time error 13 randomly while iterating emails in a public folder


I receive a random run-time error 13 (type mismatch). This routine works most of the time. The folder passed as an argument is legitimate at the time of the failure.

From what I can see in the debugger, objitem is missing some of the fields during runtime. After it break-points in the debugger, I can immediately single-step (re-executing the offending line) and there is no error.

I attempted using on error goto to sleep then retry various lines, and the error persists until it stops in the debugger.

I also attempted changing between the For ii and For Each forms of the loop commands.

I also temporarily disabled by anti-virus.

I iterate over a large number of public folders. My Outlook client is 2003 running under XP, and I am attached to Exchange Server version 7654.

Sub SearchFolders(objFolder As Outlook.MAPIFolder)
    Dim objFolders As Outlook.Folders
    Dim subFolder As Outlook.MAPIFolder
    Dim objitem As MailItem
    Dim ii As Integer

' Recurse through all subfolders
    Set objFolders = objFolder.Folders
    For Each subFolder In objFolders
    Call SearchFolders(subFolder)
    Next subFolder

' Search the emails
    For ii = 1 To objFolder.Items.Count
    If objFolder.Items(ii).Class = olMail Then
        If TypeName(objFolder.Items(ii)) <> "MailItem" Then
        MsgBox ("Type mismatch: object s/b MailItem and is " & TypeName(objFolder.Items(ii)))
        GoTo NextdblLoop
        End If
        Set objitem = objFolder.Items(ii)
        CheckEmailForErrorReports (objFolder.Items(ii))
    End If
NextdblLoop:
    Next ii
End Sub

Code below is modified per @dmitry suggestions and now works.

Sub SearchFolders(objFolder As Outlook.MAPIFolder)
    Dim objFolders As Outlook.Folders
    Dim subFolder As Outlook.MAPIFolder
    Dim Objitem As Outlook.MailItem
    Dim ii As Integer
    Dim ThisItem As Object
    Dim Items As Outlook.Items

' Recurse through all subfolders
    Set objFolders = objFolder.Folders
    For Each subFolder In objFolders
    Call SearchFolders(subFolder)
    Next subFolder

' Search the emails
    Set Items = objFolder.Items
    For ii = 1 To Items.Count
    Set ThisItem = Items.item(ii)
    If ThisItem.Class = olMail Then
        If VarType(ThisItem) = 9 Then GoTo NextdblLoop
        Set Objitem = ThisItem
        CheckEmailForErrorReports (objFolder.Items(ii))
        Set Objitem = Nothing
    End If
    Set ThisItem = Nothing
NextdblLoop:
    Next ii
    Set Items = Nothing
End Sub

Solution

  • Firstly, do not use multiple dot notation; cache the Items collection before entering the loop.

    Secondly, release the variables as soon as you are done with them

        dim item As Object
        dim Items as Outlook.Items
        set Items = objFolder.Items
        For ii = 1 To Items.Count
            set item = Items.Item(ii)
            If item.Class = olMail Then
                If TypeName(item) <> "MailItem" Then
                    'THIS CAN NEVER HAPPEN. The check above is sufficient
                    MsgBox ("Type mismatch: object s/b MailItem and is " & TypeName(item))
                    GoTo NextdblLoop
                End If
                Set objitem = item 
                CheckEmailForErrorReports (objitem)
                Set objitem = Nothing
            End If
            Set item = Nothing
    NextdblLoop:
        Next ii
    End Sub