6

I get an intermittent error when looping through the Outlook inbox using VBA. A type mismatch occurs on the Next objOutlookMesg line.

Note: I wanted to be as thourough as possible so I included all the code. Scroll to the bottom for an abreviated snip of where the error occurs.

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

Shorter snip of the code where the error occurs:

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

I think the error may have to do with the class of the mailitems. Looking to filter for that now.

Community
  • 1
  • 1
MattB
  • 2,203
  • 5
  • 26
  • 48
  • Could you maybe make your code a bit compacter to the specific relevant lines? That would be great. – dhein Sep 09 '13 at 15:42
  • Done! Sorry to be so.. code-bose, but I wanted to include plenty of information. You can see the loop where I keep encountering the error at the bottom of the original question now. Also, for the record, I hated hard-coding all those field names. I actualy worked out something with the requesting department just now to eliminate that. – MattB Sep 09 '13 at 15:59

1 Answers1

10

An outlook folder has a default object type (MailItem, AppointmentItem, ContactItem, etc) but can actually hold any item type. So you're hitting an item that's not a MailItem and, by virtue of a For Each loop, trying to assign it to a variable that is a MailItem type.

You need to loop through with a generic Object and test the TypeName.

Dim oItem As Object
Dim oMail As MailItem

For Each oItem In Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
    If TypeName(oItem) = "MailItem" Then
        Set oMail = oItem

        'do stuff with omail
    End If
Next oItem
Dick Kusleika
  • 32,673
  • 4
  • 52
  • 73
  • Thank you sir! That did it and everything finaly executed beautifuly! As a side note, I still find it particularly vexing that VBA wouldn't automatically filter for mailitems when the object I'm using in the For loop is already declared as a Outlook.Mailitem, but I'll just have to remember that the for loop is just as dependent on the collection you are iterating over. Again, many thanks, this straightened me out. – MattB Sep 09 '13 at 16:27
  • This problem is so annoying. I wish the Outlook object model for all these items all inherited from the same base class or something... it's so annoying how many features are specific to each "type" for no logical reason... – enderland Sep 09 '13 at 18:43
  • I vote that you can use oFldr.Items when you want everything or oFldr.DefaultItems when you just want the default item types. That would be awesome. – Dick Kusleika Sep 09 '13 at 20:58