Podczas wykonywania pętli w skrzynce odbiorczej programu Outlook za pomocą języka VBA pojawia się błąd. Niezgodność typu występuje w linii Next objOutlookMesg.

Uwaga: chciałem być jak najmocniejszy, więc zawarłem cały kod. Przewiń do dołu, aby uzyskać skróconą wycinkę w miejscu wystąpienia błędu.

Private Sub CheckInbox(strFolder As String, Title As String)

Dim objOutlook          As Outlook.Application
Dim objOutlookNS        As Outlook.Namespace
Dim objOutlookInbox     As Outlook.Folder
Dim objOutlookComp      As Outlook.Folder
Dim objOutlookMesg      As Outlook.MailItem
Dim Headers(1 To 20)    As String
Dim i                   As Integer

Headers(1) = "Division:"
Headers(2) = "Request:"
Headers(3) = "Exception Type:"
Headers(4) = "Owning Branch:"
Headers(5) = "CRM Opportunity#:"
Headers(6) = "Account Type:"
Headers(7) = "Created Date:"
Headers(8) = "Close Date:"
Headers(9) = "Created By:"
Headers(10) = "Account Number:"
Headers(11) = "Revenue Amount:"
Headers(12) = "Total Deposit Reported:"
Headers(13) = "Actual Total Deposits Received:"
Headers(14) = "Deposit Date:"
Headers(15) = "Deposit Source:"
Headers(16) = "Explanation:"
Headers(17) = "Shared Credit Branch:"
Headers(18) = "Shared Credit: Amount to Transfer:"
Headers(19) = "OptionsFirst: Deposit Date:"
Headers(20) = "OptionsFirst: Total Deposit:"

Set objOutlook = Outlook.Application
Set objOutlookNS = objOutlook.GetNamespace("MAPI")
Set objOutlookInbox = objOutlookNS.GetDefaultFolder(olFolderInbox)
Set objOutlookComp = objOutlookInbox.Folders(strFolder)

For Each objOutlookMesg In objOutlookInbox.Items
    objOutlookMesg.Display
    If Trim(objOutlookMesg.Subject) Like Title Then
        For i = 1 To 20
            WriteToExcel i, EmailTextExtraction(Headers(i), objOutlookMesg), 1
        Next i
        objOutlookMesg.Move objOutlookComp
    End If
Next objOutlookMesg

End Sub

Private Sub WriteToExcel(CollumnNDX As Integer, Data As String, WorksheetNDX As Integer)
'Writes data to first empty cell on the specified collumn in the specified workbook

Dim RowNDX              As Long

Do
    RowNDX = RowNDX + 1
Loop Until Worksheets(WorksheetNDX).Cells(RowNDX, CollumnNDX) = Empty

Worksheets(WorksheetNDX).Cells(RowNDX, CollumnNDX).Value = Data

End Sub

Private Function EmailTextExtraction(Field As String, Message As Outlook.MailItem) As String
'Obtains the data in a field of a text formatted email when the data
'in that field immediately follows the field and is immediately followed
'by a carriage return.

Dim Position1           As Long
Dim Position2           As Long
Dim Data                As String
Dim FieldLength         As Integer

FieldLength = Len(Field)
Position1 = InStr(1, Message.Body, Field, vbTextCompare) + FieldLength
Position2 = InStr(Position1, Message.Body, Chr(10), vbTextCompare)
'may need to use CHAR(13) depending on the carriage return
Data = Trim(Mid(Message.Body, Position1, Position2 - Position1))

EmailTextExtraction = Data

End Function

Krótszy fragment kodu, w którym występuje błąd:

For Each objOutlookMesg In objOutlookInbox.Items
    objOutlookMesg.Display
    If Trim(objOutlookMesg.Subject) Like Title Then
        For i = 1 To 20
            WriteToExcel i, EmailTextExtraction(Headers(i), objOutlookMesg), 1
        Next i
        objOutlookMesg.Move objOutlookComp
    End If
Next objOutlookMesg  <<<< intermitent type mismatch error here

Myślę, że błąd może mieć związek z klasą mailitemów. Chciałbym teraz filtrować.