Count the number of folders in your mailbox with Outlook VBA
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