CODEWITHSUNDEEP
excelvbaoutlook
M Faizan Farooq
M Faizan Farooq

Reputation: 369

Type mismatch error when returning a MailItem property of an object I assume to be a MailItem

I am putting together VBA code for Outlook. I get

"Run-time error '13': Type mismatch

The program is to import subject from inbox mails. It was working but now errors on Next olItem.

Sub PullOutlookData()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim olApp As Outlook.Application, olNs As Outlook.Namespace
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim ws As Worksheet
Dim lRow As Long
Dim vItem
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")

Set ws = ThisWorkbook.Sheets("OutlookRecord") '<--- relevant worksheet name
Set olItems = olNs.Folders("[email protected]").Folders("Inbox").Items '<--- RELEVANT FOLDER name
rCount = 1
Sheet14.Range("A1:D2000").Clear
For Each olItem In olItems
    rCount = rCount + 1
    ws.Range("A" & rCount).value = olItem.SenderName
    ws.Range("B" & rCount).value = olItem.Subject
   
Next olItem
ws.UsedRange.WrapText = False

Call SliceDice
Call FlipColumns

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub
Private Sub test()
    Application.OnTime Now + TimeValue("00:01:00"), "PullOutlookData"
End Sub

Upvotes: 1

Views: 135

Answers (1)

Tragamor
Tragamor

Reputation: 3634

Code cleaned up a bit and hopefully fixed your issue...

Sub PullOutlookData()
    On Error GoTo ExitSub
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
    ActiveSheet.DisplayPageBreaks = False

    Dim olApp As Outlook.Application: Set olApp = New Outlook.Application
    Dim olNs As Outlook.Namespace: Set olNs = olApp.GetNamespace("MAPI")
    Dim Inbox As Outlook.MAPIFolder: Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Dim olItems As Outlook.Items: Set olItems = Inbox.Items

    Dim olItem As Outlook.MailItem
    Dim ws As Worksheet, vItem As Variant, i As Long, rCount As Long

    Set ws = ThisWorkbook.Sheets("OutlookRecord") '<--- relevant worksheet name

    ws.UsedRange.ClearContents
    'Sheet14.Range("A1:D2000").Clear

    rCount = 2
    For i = 1 To olItems.Count
        Set vItem = Inbox.Items.Item(i)
        DoEvents
        If vItem.Class = olMail Then
            ws.Range("A" & rCount) = vItem.SenderName
            ws.Range("B" & rCount) = vItem.Subject
            rCount = rCount + 1    
        End If
        'If i > 100 Then Exit For
    Next i

    ws.UsedRange.WrapText = False

    'Call SliceDice
    'Call FlipColumns

ExitSub:
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With
    ActiveSheet.DisplayPageBreaks = True

End Sub

Upvotes: 1

Related Questions