get outlook mailbox size from vba

[Guest]

Hello,

I am looking for some VBA code to get the Outlook Mailbox size on the
exchange server from Access.

I found this url http://support.microsoft.com/kb/320071 but not support by
VBA.

I am sending email from Access using the Outlook SendObject and before
sending I want to check the Mailbox size to ensure the Mailbox size is under
the size quota.

Appreciate any help.

bobm

 

[Guest]

Sub GetFolderSize()
Dim lFolderSize As Long
Dim objSubFolder As MAPIFolder

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objOutlookToday = objInbox.Parent

For Each objSubFolder In objOutlookToday.Folders
lFolderSize = lFolderSize + GetSubFolderSize(objSubFolder)
Next
MsgBox "Total Size = " & lFolderSize
End Sub

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

' process all the subfolders of this folder
For Each objSubFolder In objFolder.Folders
'Do something with objFolder
lFolderSize = lFolderSize + GetSubFolderSize(objSubFolder)
Next

GetSubFolderSize = lFolderSize
Set objFolder = Nothing
Set objItem = Nothing
End Function

 

[Guest]

Sub GetFolderSize()
Dim lFolderSize As Long
Dim objSubFolder As MAPIFolder

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objOutlookToday = objInbox.Parent

For Each objSubFolder In objOutlookToday.Folders
lFolderSize = lFolderSize + GetSubFolderSize(objSubFolder)
Next
MsgBox "Total Size = " & lFolderSize
End Sub

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

' process all the subfolders of this folder
For Each objSubFolder In objFolder.Folders
'Do something with objFolder
lFolderSize = lFolderSize + GetSubFolderSize(objSubFolder)
Next

GetSubFolderSize = lFolderSize
Set objFolder = Nothing
Set objItem = Nothing
End Function

 

[Guest]

Good info. I was hoping that there was a direct property to pull the mailbox
size from instead of traversing all the folders and items under the mailbox
object, but I guess not. I am not allowed to install any third party add-ins
on the client PCs, so I guess this is the only way?

In using this, I have found a problem. Encrypted emails. The size
property will not pull when it encounters an encrypted email. I error out
with a -2147217660 - Method 'Size' of object 'MailItem' failed.

Any suggestions on either of these questions? Is there a more direct way
of pulling a size from the mailbox or even the individual folders (inbox,
sent, etc) without traversing through each item and without installing any
other add-ins? If not - any way around the encrypted problem.... ??

Thanks,
Jason

 

[jumpjack]

I spent some hours looking for the answer with no luck; it looks like this quite an hard issue!
But I eventually got it, so here it is the solution for VBA+Exchange: this macro shows properties of a mailbox, including quotas.

Public Sub ShowQuotas()
' Show Outlook Exhange user quotas
' ----------
' References:
' Accessing Exchange proerties: https://msdn.microsoft.com/EN-US/library/office/ff863046.aspx
' Outlook quotas: http://blogs.technet.com/b/outlooking/archive/2013/09/19/mailbox-quota-in-outlook-2010-general-information-and-troubleshooting-tips.aspx
' Properties for quotas: http://blogs.msdn.com/b/stephen_griffin/archive/2012/04/17/cached-mode-quotas.aspx
' Property format: https://msdn.microsoft.com/en-us/library/ee159391(v=exchg.80).aspx
'    http://schemas.microsoft.com/mapi/proptag/0xQQQQRRRR
'    QQQQ = id
'    RRRR = type

    Dim oStore As Store
    Dim propertyAccessor As Outlook.propertyAccessor
  
    For Each oStore In Outlook.Application.Session.Stores
   ' Set oStore = Outlook.Application.Session.Stores.item(1)
        Debug.Print "Display name: " & oStore.DisplayName
        Debug.Print "Type: " & oStore.ExchangeStoreType & " (";
            If oStore.ExchangeStoreType = olAdditionalExchangeMailbox Then Debug.Print "olAdditionalExchangeMailbox)"
            If oStore.ExchangeStoreType = olExchangeMailbox Then Debug.Print "olExchangeMailbox)"
            If oStore.ExchangeStoreType = olExchangePublicFolder Then Debug.Print "olExchangePublicFolder)"
            If oStore.ExchangeStoreType = olNotExchange Then Debug.Print "olNotExchange)"
            If oStore.ExchangeStoreType = olPrimaryExchangeMailbox Then Debug.Print "olPrimaryExchangeMailbox)"
        Debug.Print "Path: " & oStore.FilePath
        Debug.Print "Cached (=online): " & oStore.IsCachedExchange

        Set propertyAccessor = oStore.propertyAccessor
        If oStore.ExchangeStoreType = olExchangePublicFolder Or oStore.ExchangeStoreType = olPrimaryExchangeMailbox Then
            PR_QUOTA_WARNING = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x341A0003") / 1024
            PR_QUOTA_SEND = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x341B0003") / 1024
            PR_QUOTA_RECEIVE = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x341C0003") / 1024
            PR_MESSAGE_SIZE_EXTENDED = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E080014") / 1024
            PR_MESSAGE_SIZE_EXTENDED = PR_MESSAGE_SIZE_EXTENDED / 1024
            Debug.Print "PR_QUOTA_WARNING: " & PR_QUOTA_WARNING & " MB"
            Debug.Print "PR_QUOTA_SEND: " & PR_QUOTA_SEND & " MB"
            Debug.Print "PR_QUOTA_RECEIVE: " & PR_QUOTA_RECEIVE & " MB"
            Debug.Print "PR_MESSAGE_SIZE_EXTENDED (Inbox size): " & Round(PR_MESSAGE_SIZE_EXTENDED) & " MB (=" & Round(100 * PR_MESSAGE_SIZE_EXTENDED / PR_QUOTA_RECEIVE) & "%)"
            Debug.Print "Free space: " & Round(PR_QUOTA_RECEIVE - PR_MESSAGE_SIZE_EXTENDED) & " MB"
        Else
            Debug.Print "   Quota data not available for local storage"
        End If
        Debug.Print "------------"
    Next
    Set oStore = Nothing
End Sub