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




Reply With Quote