Public Sub Get_Outlook_Folders()
Dim outNameSpace As Namespace
Dim outStartFolder As MAPIFolder
Dim headings As Variant
headings = Array("Folder Path", "Size", "Items", "Unread", "Structure")
Set outNameSpace = Outlook.Application.GetNamespace("MAPI")
Set outStartFolder = outNameSpace.Folders("Personal Folders")
With Range("A1")
.Parent.Cells.Clear
.Resize(1, UBound(headings) + 1).Value = headings
End With
Process_Folder2 outStartFolder, Range("A2")
End Sub
Private Function Process_Folder2(outFolder As Outlook.MAPIFolder, destCell As Range) As Integer
Dim n As Integer
Dim outSubfolder As MAPIFolder
Dim outItem As Object
Dim folderSize As Long
'Calculate size in bytes of all items in this folder
folderSize = 0
For Each outItem In outFolder.Items
folderSize = folderSize + outItem.Size
Next
With destCell.Parent.Cells(destCell.Row, 1) 'always start in column A
.Offset(0, 0).Value = outFolder.folderPath
.Offset(0, 1).Value = Round(folderSize / 1024) * 1024 \ 1024 & " KB" 'round to nearest 1024 and convert to KB
.Offset(0, 2).Value = outFolder.Items.Count
.Offset(0, 3).Value = outFolder.UnReadItemCount
End With
destCell.Offset(0, 4).Value = outFolder.Name
n = 0
For Each outSubfolder In outFolder.Folders
n = n + 1
n = n + Process_Folder2(outSubfolder, destCell.Offset(n, 1))
Next
Process_Folder2 = n
End Function