Question

I am trying to list all email in Excel within all sub folders from Outlook:

I have searched and researched this for weeks without any luck.

'Requires reference to Outlook library
Option Explicit

Public Sub ListOutlookFolders()

    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim rngOutput As Range
    Dim lngCol As Long
    Dim olItem As Outlook.MailItem

    Dim rng As Excel.Range
    Dim strSheet As String
    Dim strPath As String

    Set rngOutput = ActiveSheet.Range("A1")

    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")

    For Each olFolder In olNamespace.Folders
        rngOutput = olFolder.Name
        rngOutput.Offset(0, 1) = olFolder.Description
        Set rngOutput = rngOutput.Offset(1)
        For Each olItem In olFolder.Items
            Set rngOutput = rngOutput.Offset(1)
            With rngOutput
                .Offset(0, 1) = olItem.SenderEmailAddress ' Sender
            End With
        Next

        Set rngOutput = ListFolders(olFolder, 1, rngOutput)
    Next

    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing

End Sub

Function ListFolders(MyFolder As Outlook.MAPIFolder, Level As Integer, theOutput As Range) As Range        
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Outlook.MailItem
    Dim lngCol As Long

    For Each olFolder In MyFolder.Folders
        theOutput.Offset(0, lngCol) = olFolder.Name
        Set theOutput = theOutput.Offset(1)

        If (olFolder.DefaultItemType = olMailItem) And (Not olFolder.Name = "Slettet post") Then
            For Each olItem In olFolder.Items
                If olItem.Class = olMail Then
                    With theOutput
                        .Offset(0, 1) = olItem.SenderEmailAddress ' Sender
                    End With
                    Set theOutput = theOutput.Offset(1)
                End If
            Next olItem <--- ERROR 13 here
        End If
        If olFolder.Folders.Count > 0 Then
            Set theOutput = ListFolders(olFolder, Level + 1, theOutput)
        End If
    Next olFolder
    Set ListFolders = theOutput.Offset(1)

End Function

The code runs fine for 10-20 items and then gives me an run time error 13 in the line stated above and when I hit debug it tells me that olItem is = Nothing !? – When I hit single step the code runs again fine for a while again.

I have tried to insert a “ON ERROR” but then my list doesn’t contain all emails.

Answer 1

I’m baring my code to you 🙂

Change
Dim olItem As Outlook.MailItem
to
Dim olItem As Object

Not all the folder items will be mailitems, so avoid dimensioning your olItem variable in this manner. This change worked fine on my machine, while originally I had the same error you did