Count Outlook Mailbox file size

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:

Code:

---

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

---

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.

Code:

---

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."

---

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.

Code:

---

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

---