A strange request came from one of our customers today, asking to create a list of all folders under a windows share and create a list of all folders under several mailboxes running on Microsoft Exchange Server and Outlook clients.
The first request is quite straight forward.
There are 2 options, one is to list with the files and one with only the folders.
Folders & Files: dir /b/s > filelist.txt
Folders only: dir /ad/b/s > dirlist.txt
Based on the fact that we had around 11.000 folders, the dir command worked just fine.
The Outlook part was a bit more tricky.
In order to accomplish that, a VB script needs to be executed on Outlook (found below).
Outlook client may have macros disabled so you may have to go to Outlook Tools, Macros, Security and enable warning for all macros.
The following VB script will create a list of all folders under a mailbox (it will popup the list of the mailboxes available on the outlook profile running the script) and then create a new email message with a listing of the folders attached.
Open your Outlook, then open the VB Editor by pressing Alt+F11.
Right click on Project1 and Insert -> Module.
Paste the code found below and run.
Public strFolders As String
Public Sub GetFolderNames()
Dim olApp As Outlook.Application
Dim olSession As Outlook.NameSpace
Dim olStartFolder As Outlook.MAPIFolder
Dim lCountOfFound As Long
lCountOfFound = 0
Set olApp = New Outlook.Application
Set olSession = olApp.GetNamespace("MAPI")
' Allow the user to pick the folder in which to start the search.
Set olStartFolder = olSession.PickFolder
' Check to make sure user didn't cancel PickFolder dialog.
If Not (olStartFolder Is Nothing) Then
' Start the search process.
ProcessFolder olStartFolder
End If
' Create a new mail message with the folder list inserted
Set ListFolders = Application.CreateItem(olMailItem)
ListFolders.Body = strFolders
ListFolders.Display
' clear the string so you can run it on another folder
strFolders = ""
End Sub
Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
Dim i As Long
Dim olNewFolder As Outlook.MAPIFolder
Dim olTempFolder As Outlook.MAPIFolder
Dim olTempFolderPath As String
' Loop through the items in the current folder.
For i = CurrentFolder.Folders.Count To 1 Step -1
Set olTempFolder = CurrentFolder.Folders(i)
olTempFolderPath = olTempFolder.FolderPath
'prints the folder path and name in the VB Editor's Immediate window
Debug.Print olTempFolderPath
' prints the folder name only
' Debug.Print olTempFolder
' create a string with the folder names.
' use olTempFolder if you want foldernames only
strFolders = strFolders & vbCrLf & olTempFolderPath
lCountOfFound = lCountOfFound + 1
Next
' Loop through and search each subfolder of the current folder.
For Each olNewFolder In CurrentFolder.Folders
'Don't need to process the Deleted Items folder
If olNewFolder.Name <> "Deleted Items" Then
ProcessFolder olNewFolder
End If
Next
End Sub
