Count Outlook Mailbox file size

[dicepackage]

I would like to write a program to count the size of several mailboxes in outlook as well as counting the size of the subfolders. I would like to use either Access or Excel to achieve this. I can get the program so it will calculate Inbox, Sent Items, Drafts, Trash but if I create a folder called Test it will not work.

How do I make it so it can see this folder Test? I would also like to see other shared mailboxes and be able to calculate the size on those as well.

Here is an example of the code I am currently using:

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") 
     
    Dim objTest As Outlook.MAPIFolder 
    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

[dicepackage]

I am also working on a different code set. If I can get either one working I will be happy. I would just like to change this example from Inbox to a folder I created called Test.

Dim objOutlook As Outlook.Application 
Dim objNS As Outlook.NameSpace 
Dim objFolder As Outlook.MAPIFolder, objUnknown As Object 
Dim lngBytes As Long, intX As Integer 
 
Set objOutlook = New Outlook.Application 
Set objNS = objOutlook.GetNamespace("MAPI") 
Set objFolder = objNS.GetDefaultFolder(olFolderInbox) 
 
For intX = 1 To objFolder.Items.Count 
    lngBytes = lngBytes + objFolder.Items.item(intX).Size 
Next 
 
MsgBox "Folder size is " & lngBytes / 1024 & "kilo-bytes."

[dicepackage]

With a little more persistence and some more sample code I found online I was able to get this working. I'm posting the solution here in case anyone stumbles on this problem and needs a solution. Sorry for the lack of comments.

Function GetSubFolderSize(objFolder As MAPIFolder) As Long
    Dim lFolderSize As Long
    Dim objSubFolder As MAPIFolder
    
    For Each objItem In objFolder.Items
        lFolderSize = lFolderSize + objItem.Size
    Next

    For Each objSubFolder In objFolder.Folders
        lFolderSize = lFolderSize + GetSubFolderSize(objSubFolder)
    Next
    
    GetSubFolderSize = lFolderSize
    Set objFolder = Nothing
    Set objItem = Nothing
End Function

Private Sub CommandButton1_Click()
    Dim FolderSize As Long
    Dim objSubFolder As MAPIFolder
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    
    Set objOutlookToday = objNS.Folders("Mailbox - Shared Mailbox Name").Folders("Test")
'Will look for the folder Test in Mailbox - Shared Mailbox Name

    ' This 1st loop checks the root folder itself
    For Each objItem In objOutlookToday.Items
        FolderSize = FolderSize + objItem.Size
    Next
    ' This next loop checks the subfolders.  Omit this loop if you do not intend to check the subfolders
    For Each objSubFolder In objOutlookToday.Folders
        FolderSize = FolderSize + GetSubFolderSize(objSubFolder)
    Next
    MsgBox(FolderSize)
End Sub