get outlook mailbox size from vba

  • Thread starter Thread starter Guest
  • Start date Start date
G

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

Code: 
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
 
Back
Top