A coworker asked me today if I knew how to count up the total number of folders in his mailbox, in the process of troubleshooting a bug related to having a large number of folders. I had an old script that recursed through a mailbox to count the total number of items (also written for the purposes of troubleshooting a bug many years ago where two clients showed different item counts, a lot of my macros start out that way :-) so I modified it to count folders and figured I'd share it.

Disclaimer: I performed a small amount of testing on this and it seems to be OK, but it wasn't extensive - let me know if you find a bug.

And of course, like all of my macros, it has no error checking and may forget to declare variables before using them, yadda yadda :-)

Sub CountFoldersInMBX()

Dim outapp As Outlook.Application
Set outapp = CreateObject("Outlook.Application")
Dim olns As Outlook.NameSpace
Set olns = outapp.GetNamespace("MAPI")
MsgBox "Total: " & GetSubFolderCount(olns.GetDefaultFolder(olFolderInbox).Parent)


End Sub

Function GetSubFolderCount(objParentFolder As MAPIFolder) As Long
 

Dim currentFolders As Folders
Dim fldCurrent As MAPIFolder

Set currentFolders = objParentFolder.Folders
If currentFolders.Count > 0 Then
   Set fldCurrent = currentFolders.GetFirst
   While Not fldCurrent Is Nothing
      TempFolderCount = TempFolderCount + GetSubFolderCount(fldCurrent)
      Set fldCurrent = currentFolders.GetNext
   Wend
   GetSubFolderCount = TempFolderCount + currentFolders.Count
Else
    GetSubFolderCount = 0
End If
End Function