Home > Publications & Training > Case Studies > MS Outlook folder list
Google
Web This Site

List all folders in a Microsoft Outlook account

Recently, I wanted to create a list of all the folders in my MS Outlook PST file together with the size of each folder.† Outlook provides that information through the user interface.† Unfortunately, it shows the result in a modal dialog with no way to save the information elsewhere.† So, I decided to check if I could find some ready-to-use (or nearly ready-to-use) code that did the needful.† A search of the web led to several ideas and suggestions but no code to do the needful.† So, I decided to put together a VBA module that would save the information in an Excel worksheet.

One caveat: I am not an Outlook expert.† The code below works for me.† I use Outlook with a single profile, a single PST file in that profile, and the PST file is on a local drive Ė my mail, calendar, and contacts are in that file and not on a server.† So, whether the below will work with a different configuration is something you will have to check for yourself.

The result of the code below matches what Outlook shows in the dialog box that lists folders and their respective sizes.† So, at least for me it works as intended both with Outlook 2007 and Outlook 2010 64bit.

Performance leaves something to be desired.† In the Outlook object model, folders donít contain size information.† So, the code has to go through every item in every folder to accumulate the necessary data.

Recent Comments

Mike on Mar. 1, 2013:

Your logic and explanantions were very helpful.  Look forward to hearing from you

 

Implementation

The core routine is a recursive subroutine that processes a single Outlook folder.† It calls itself for each subfolder contained in that folder.† The result will be in a new worksheet in the active workbook and if that is not possible in a new worksheet in a new workbook.† The result will be grouped using the Excel Group Outline feature based on the depth of the Outlook folder hierarchy.

To use the code, first copy it into the appropriate code module as described below.† Then, use ALT+F8 to bring up the Macro dialog box.† In there, select and run the OLFolderSize subroutine.

The code goes into two modules.† In a class module named clsGroupInfo enter the following:

Option Explicit

 

Public StartIdx As Long, EndIdx As Long, Name As String

 

In a standard module enter the following:

Option Explicit

Option Base 0

#Const EarlyBind = False

 

Function ArrLen(Arr, Optional ByVal WhichDim As Integer = 1) As Long

††† ArrLen = UBound(Arr, WhichDim) - LBound(Arr, WhichDim) + 1

††† End Function

Function getDestWS() As Worksheet

††† Dim WS As Worksheet

††† On Error Resume Next

††† Set WS = ActiveWorkbook.Worksheets.Add()

††† If WS Is Nothing Then _

††††††† Set WS = Workbooks.Add().Worksheets.Add()

††† On Error GoTo 0

††† Set getDestWS = WS

††† End Function

#If EarlyBind Then

Sub getAFolderInfo(ByVal NestLevel As Integer, _

††††††† ByVal aFolder As Outlook.Folder, ByRef Rslt(), _

††††††† ByRef AllGroups As Collection)

#Else

Sub getAFolderInfo(ByVal NestLevel As Integer, _

††††††† ByVal aFolder As Object, ByRef Rslt(), _

††††††† ByRef AllGroups As Collection)

††† #End If

††† Application.StatusBar = aFolder.FolderPath

††† Dim I As Long: I = UBound(Rslt, 2) + 1

††† Dim aGroup As clsGroupInfo: Set aGroup = New clsGroupInfo

††† aGroup.StartIdx = I: aGroup.Name = aFolder.Name

††† ReDim Preserve Rslt(UBound(Rslt), I)

††† Rslt(0, I) = aFolder.Name

††† Rslt(1, I) = aFolder.FolderPath

††† Rslt(2, I) = NestLevel

††† Dim anItem As Object, NbrItems As Long, FolderSize As Long

††† For Each anItem In aFolder.Items

††††††† NbrItems = NbrItems + 1

††††††† FolderSize = FolderSize + anItem.Size

††††††† Next anItem

††† Rslt(3, I) = NbrItems

††† Rslt(4, I) = FolderSize

††† Rslt(5, I) = FolderSize 'foldersize incl. subfolders

††† Rslt(6, I) = I

††† #If EarlyBind Then

††† Dim aSubFolder As Outlook.Folder

††† #Else

††† Dim aSubFolder As Object

††††††† #End If

††† For Each aSubFolder In aFolder.Folders

††††††† Dim ChildRow As Long: ChildRow = UBound(Rslt, 2) + 1

††††††† getAFolderInfo NestLevel + 1, aSubFolder, Rslt, AllGroups

††††††† Rslt(5, I) = Rslt(5, I) + Rslt(5, ChildRow)

††††††† Next aSubFolder

††† aGroup.EndIdx = UBound(Rslt, 2)

††† AllGroups.Add aGroup, aGroup.StartIdx & "-" & aGroup.EndIdx

††† End Sub

Sub createGroups(WS As Worksheet, AllGroups As Collection)

††† Dim aGroup As clsGroupInfo

††† WS.Outline.SummaryRow = xlSummaryAbove

††† For Each aGroup In AllGroups

††††††† With aGroup

††††††† If .StartIdx > 2 Then _

††††††††††† WS.Rows(.StartIdx + 1).Resize(.EndIdx - .StartIdx + 1).Group

††††††††††† End With

††††††† Next aGroup

††† End Sub

Sub OLFolderSize()

†††

††† Dim WS As Worksheet

††† Set WS = getDestWS()

††† If WS Is Nothing Then _

††††††† MsgBox "Unable to create a result worksheet! :(": Exit Sub

†††

††† Dim Rslt(): ReDim Rslt(6, 1)

††† Rslt(0, 0) = "Start": Rslt(1, 0) = Now()

††† Rslt(0, 1) = "Name"

††† Rslt(1, 1) = "Path"

††† Rslt(2, 1) = "Depth"

††† Rslt(3, 1) = "Item Count"

††† Rslt(4, 1) = "Folder Size"

††† Rslt(5, 1) = "Size incl. subfolders"

††† Rslt(6, 1) = "Unique ID"

††† Dim AllGroups As Collection: Set AllGroups = New Collection

††† #If EarlyBind Then

††† Dim OL As Outlook.Application, NS As Outlook.Namespace, _

††††††† aFolder As Outlook.Folder

††† #Else

††† Dim OL As Object, NS As Object, aFolder As Object

††††††† #End If

††† Set OL = CreateObject("outlook.application")

††† Set NS = OL.GetNamespace("MAPI")

††† For Each aFolder In NS.Folders

††††††† getAFolderInfo 0, aFolder, Rslt, AllGroups

††††††† Next aFolder

††† Rslt(2, 0) = "Complete": Rslt(3, 0) = Now()

††† With WS

††† .Cells(1, 1).Resize(ArrLen(Rslt, 2), ArrLen(Rslt, 1)) = _

††††††† Application.WorksheetFunction.Transpose(Rslt)

††† .Columns(1).Resize(, ArrLen(Rslt, 1)).NumberFormat = "#,##0"

††† .Rows(1).NumberFormat = "hh:mm:ss"

††††††† End With

††† Application.StatusBar = False

††† createGroups WS, AllGroups

††† End Sub

 

 

 

Share Your Comments