Looping Recursively Through Folders and Subfolders

Outlook Object Model: List All Folders

With a recursive loop through all the folders you can, for instance, get all their contents without the need to know each folder name. This is useful if at programming time you don't know which or how many folders will be existent. This sample demonstrates the basics, which can easily be reused for different needs.

  How to add macros to Outlook

Public Sub LoopFolders(Folders As Outlook.Folders, _
  ByVal Recursive As Boolean _
)
  Dim Folder As Outlook.MAPIFolder

  For Each Folder In Folders
    DoAnything Folder

    If Recursive Then
      LoopFolders Folder.Folders, Recursive
    End If
  Next
End Sub

Private Sub DoAnything(Folder As Outlook.MAPIFolder)
  Debug.Print Folder.Name
End Sub

Implementation: Change Folder Settings

Here comes an implementation for the above recursive loop through all folders: For a selected folder and its subfolders we set to not display the number of unread items but the number of all items.

Add the function 'ChangeFolderSettings' to the both functions above. Note the variable 'EditSubfolders': It controls whether the setting will be changed only for the subfolders of the selected folder or also for the selected one itself.

Public Sub ChangeFolderSettings()
  Dim Folder As Outlook.MapiFolder
  Dim EditSubfoldersOnly As Boolean

  'Select start folder
  Set Folder = Application.Session.PickFolder

  'True will change subfolders only, False will also change the start folder itself
  EditSubfoldersOnly = False

  If Not Folder Is Nothing Then
    If EditSubfoldersOnly = False Then DoAnything Folder

    LoopFolders Folder.Folders, True
  End If
End Sub

In the function 'DoAnything' we need to change only a single line:

Private Sub DoAnything(Folder As Outlook.MAPIFolder)
  'Setting the property to True will display all items, 
  'False would display unread items only
  Folder.ShowItemCount = True
End Sub

Outlook Object Model: List All Folder Contents

This sample extends the folder loop by a loop through all of the items of each folder.

Public Sub LoopFolders(Folders As Outlook.Folders, _
  ByVal Recursive As Boolean _
)
  Dim Folder As Outlook.MAPIFolder

  For Each Folder In Folders
    LoopItems Folder.Items

    If Recursive Then
      LoopFolders Folder.Folders, Recursive
    End If
  Next
End Sub

Private Sub LoopItems(Items As Outlook.Items)
  Dim obj As Object

  For Each obj In Items
    If TypeOf obj Is Outlook.MailItem
      DoAnything obj
    End If
  Next
End Sub

Private Sub DoAnything(Item As Outlook.MailItem)
  Debug.Print Item.Subject
End Sub

CDO 1.21: List All Folders

The samples above for the OOM work with all versions of Outlook, however, up to and including Outlook 2003 they are pretty slowly. For these versions of Outlook the CDO 1.21 library is much faster.

Public Sub LoopFolders(Folders As MAPI.Folders, _
  ByVal Recursive As Boolean _
)
  Dim Folder As MAPI.Folder

  For Each Folder In Folders
    DoAnything Folder

    If Recursive Then
      LoopFolders Folder.Folders, Recursive
    End If
  Next
End Sub

Private Sub DoAnything(Folder As MAPI.Folder)
  Debug.Print Folder.Name
End Sub

CDO 1.21: List All Folder Contents

Here comes the CDO version for listing the folder contents.

Public Sub LoopFolders(Folders As MAPI.Folders, _
  ByVal Recursive As Boolean _
)
  Dim Folder As MAPI.Folder

  For Each Folder In Folders
    LoopItems Folder.Messages

    If Recursive Then
      LoopFolders Folder.Folders, Recursive
    End If
  Next
End Sub

Private Sub LoopItems(Items As MAPI.Messages)
  Dim obj As Object

  For Each obj In Items
    If TypeOf obj Is MAPI.Message
      DoAnything obj
    End If
  Next
End Sub

Private Sub DoAnything(Item As MAPI.Message)
  Debug.Print Item.Subject
End Sub