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?
' 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.