outlook VBA script run-time error 13 randomly whil

2019-09-11 09:30发布

I am receiving a random run-time error 13 (type mismatch) executing the following subroutine. This routine works most of the time. The Folder passed in as an argument is legitimate at the time of the failure. From what I can see in the debugger, the 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 have attempted using 'on error goto' to sleep then retry various lines, and the error persists until it stops in the debugger.

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

I have also temporarily disabled by anti-virus.

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

Can anyone tell me what I am failing to do (or if what I am attempting is not possible)?

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

1条回答
时光不老,我们不散
2楼-- · 2019-09-11 09:59

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
查看更多
登录 后发表回答