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
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