Outlook to excel automation

[Shantanu_4612]

Hi all,

I have found the below mentioned code for outlook 15.0
Can someone help me to make changes in the code for outlook 10.0 which can be used in a button in excel user form to extract data in "extract raw" sheet
this code is giving me "2147221233 (8004010f)" error

Below is the code

' Requires Tools-->References-->Microsoft Outlook 15.0 Object Library
Sub getEmails()

    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFldr As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olMailItem As Outlook.MailItem
    Dim ws As Worksheet
    Dim iRow As Long
    Dim hdr As Variant
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    
    Set olFldr = olNS.Folders(1)
    Set olFldr = olFldr.Folders("Inbox")
    Set olFldr = olFldr.Folders("MrExcel")
    Set olFldr = olFldr.Folders("Keep")
    
    ws.Cells.Clear
    iRow = 2
    
    Application.ScreenUpdating = False
    For Each olItem In olFldr.Items
        If olItem.Class = olMail Then
            Set olMailItem = olItem
            With olMailItem
                ws.Cells(iRow, "A") = .Sender
                ws.Cells(iRow, "B") = .SenderEmailAddress
                ws.Cells(iRow, "C") = .SenderName
                ws.Cells(iRow, "D") = .Subject
                ws.Cells(iRow, "E") = .ReceivedTime
                ws.Cells(iRow, "F") = .Categories
                ws.Cells(iRow, "G") = .TaskCompletedDate
                ws.Cells(iRow, "H") = olFldr.Name
                iRow = iRow + 1
            End With
        End If
    Next olItem

    With ws
        hdr = Array("Sender", "SenderEmailAddress", "SenderName", "Subject", "ReceicedTime", "Categories", "TaskCompletedDate", "Folder")
        .Range("A1").Resize(, UBound(hdr)) = hdr
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = False
End Sub

 

[healey21]

Two questions.

1. Have you set the reference to use Outlook 10.0 (Use the Tools Menu and References and search down for Microsoft Outlook 10.0 Object Library and select teh check box.
2. Have you stepped through the code to see where it is giving you the problem.

On a quick look what if you change this line.

ws.Cells(iRow, "H") = olFldr.Name

To

ws.Cells(iRow, "H") = .olFldr.Name

 

[Shantanu_4612]

Hi healey,

I tried doing the recommended changes, but it isn't working.

Still same error.

And I am sorry, I am looking for a macron for outlook 12.0 and not 10.0

 

[RoryA]

Which line causes the error?

 

[Shantanu_4612]

Hi,

Thank you for your reply
But I am not sure which line is causing the error as I am getting it as soon as I am running it.