List all top level folders in an Outlook mailbox using VBA

Let’s say I wanted to list all the folders for a top level folder such as LargeOldEmails2 using VBA. How would I do it?

Outlook 2010 top level folders

' We will explicitly declare all variables using
' Dim or ReDim keywords. This is good practice
Option Explicit

' Let's declare a constant string that holds
Const FOLDER_OF_INTEREST As String = "LargeOldEmails2"

' List all accounts I have in Outlook
Sub ListAccounts()

    ' Let's get the current application's session
    Dim Session As Outlook.NameSpace
    Set Session = Application.Session

    ' Now let's get top level accounts. They are
    ' folders according to Outlook
    Dim Folders As Outlook.Folders
    Set Folders = Session.Folders

    ' Now that we have a collection of folders, let's
    ' list each folder's name. If we find a folder that
    ' we are interested in, let's stop at that point
    Dim Folder As Outlook.Folder
    Dim FolderOfInterestFound As Boolean
    FolderOfInterestFound = False
    For Each Folder In Folders
        ' I am interested only in Sent Items top level folder
        ' When I see it, just stop looping.
        If Folder.Name = FOLDER_OF_INTEREST Then
            FolderOfInterestFound = True
            Exit For
        End If
    Next

    ' Aha, we have stopped looping. Let's see if we found the
    ' folder we were interested in
    If Not FolderOfInterestFound Then
        Debug.Print "The folder of our interest " & FOLDER_OF_INTEREST & " was not found"
        Exit Sub
    End If

    Debug.Print "Listing all folders for " & Folder.Name

    ' List all folders
    RecurseFolders Folder

End Sub

' Given a folder, list out all the folders and send them to this
' same procedure again
Private Sub RecurseFolders(ByVal CurrentFolder As Outlook.Folder)

    ' Is this a folder? Yes? Oh, good. Let's peek into this folder
    If CurrentFolder.Class = olFolder Then

        ' let's write out the path of this folder first
        Debug.Print CurrentFolder.FolderPath

        ' Okay, let's see if this folder has any subfolders
        If CurrentFolder.Folders.Count > 0 Then

            ' Oh, this folder has more folders. Let's go through
            ' them all. For each folder we find, let's send them
            ' through this same procedure to find if there are
            ' any more subfolders
            Dim SubFolders As Outlook.Folders
            Dim SubFolder As Outlook.Folder
            Set SubFolders = CurrentFolder.Folders
            For Each SubFolder In SubFolders
                RecurseFolders SubFolder
            Next

        End If  ' count > 0 ends

    End If ' oFolder check ends

End Sub

How is this helpful? There are multiple uses for this. It helps counting the number of folders in the top level folder. Also, this helps isolate a folder of interest and do something with it, such as find how many emails it contains. It helps run statistics about email items in each folder and when was the last one created etc.