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
Re: Count Outlook Mailbox file size
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."
Re: Count Outlook Mailbox file size
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