Htykuut

I am putting together a VBA macro for Outlook and I am getting a "Run-time error '13': Type mismatch. I am not that experienced with VBA so I could really use some help. The program is to import subject from inbox mails of outlook, it was working fine but now Runtime error '13' on line "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("faizan.farooq@ke.com.pk").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

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