Public gFolders As String

Public Sub GetFolderNames()
Dim oSession As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
Dim oNewMail As Outlook.mailItem

Set oSession = Outlook.Application.GetNamespace("MAPI")
Set oFolder = oSession.PickFolder

If (oFolder Is Nothing) Then Exit Sub

ProcessFolder oFolder

Set oNewMail = Application.CreateItem(olMailItem)
oNewMail.Body = gFolders
oNewMail.Display

gFolders = ""
End Sub

Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)

Dim i As Long
Dim oSubFolder As Outlook.MAPIFolder
Dim oFolder As Outlook.MAPIFolder
Dim sFolderPaths As String

    For i = CurrentFolder.Folders.Count To 1 Step -1
Set oFolder = CurrentFolder.Folders(i)

sFolderPaths = oFolder.FolderPath
gFolders = gFolders & vbCrLf & sFolderPaths & " " & oFolder.Items.Count
Next

For Each oSubFolder In CurrentFolder.Folders
If oSubFolder.Name <> "Deleted Items" Then
ProcessFolder oSubFolder
End If

Next

End Sub