Hi OTWarrior,
I've barely touched Outlook, so no doubt a crude attempt, but maybe enough to get the thread started?
In a Standard Module:
Option Explicit
Enum eFol
olFolDeletedItems = 3
olFolDrafts = 16
olFolInbox = 6
olFolSentMail = 5
End Enum
Sub exa_folsize()
Dim OL As Object '<--- Outlook.Application
Dim olNameSpace As Object '<--- NameSpace
Dim oDefFol As Object '<--- MAPIFolder
Dim olSubFol As Object '<--- MAPIFolder
Dim x As Long
Dim y As Long
Dim vntDef As Variant
Dim aryInfo As Variant
Dim aryOutput As Variant
With Range("A1:D1")
.Value = Array("Folder", "Size(kb)", "Subfolder(s)", "Size(kb)")
.Font.Bold = True
End With
'// To match above labels, as we initially do not know how many folders/subfolders //
'// we may find - we'll start an array with 4 rows and unk columns; then transpose //
'// later. //
ReDim aryInfo(1 To 4, 0 To 0)
'// I believe Outlook is single instance, so CreateObject should be okay. //
Set OL = CreateObject("Outlook.Application")
Set olNameSpace = OL.GetNamespace("MAPI")
For Each vntDef In Array(olFolDeletedItems, olFolSentMail, olFolDrafts, olFolInbox)
Set oDefFol = olNameSpace.GetDefaultFolder(vntDef)
If oDefFol.Items.Count > 0 Then
ReDim Preserve aryInfo(1 To 4, 1 To UBound(aryInfo, 2) + 1)
aryInfo(1, UBound(aryInfo, 2)) = oDefFol.Name
aryInfo(2, UBound(aryInfo, 2)) = AddSize(oDefFol)
End If
If oDefFol.Folders.Count > 0 Then
For Each olSubFol In oDefFol.Folders
ReDim Preserve aryInfo(1 To 4, 1 To UBound(aryInfo, 2) + 1)
aryInfo(3, UBound(aryInfo, 2)) = olSubFol.Name
aryInfo(4, UBound(aryInfo, 2)) = AddSize(olSubFol)
Next
End If
Next
ReDim aryOutput(1 To UBound(aryInfo, 2), 1 To 4)
For x = 1 To UBound(aryInfo, 2)
For y = 1 To 4
aryOutput(x, y) = aryInfo(y, x)
Next
Next
Range("A2").Resize(UBound(aryInfo, 2), 4).Value = aryOutput
Range("A1:D1").EntireColumn.AutoFit
End Sub
Function AddSize(Fol As Object) As Long 'Fol As MAPIFolder
Dim oMailItem As Object
Dim lSize As Long
lSize = 0
For Each oMailItem In Fol.Items
lSize = lSize + oMailItem.Size
Next
'// Return in KB //
AddSize = lSize \ 1024
End Function
Hope that helps,
Mark