A Script for Getting Mailbox Sizes (using MAPI)

Originally published July 7, 2004.

(Note November 13, 2007: One of my top 5 postings EVER. Could use some updating.)

 

First, this is a MAPI script. But it'll run most quickly on an Exchange server.

Second, permissions can be an issue! By default in Exchange 200x, Domain Admins and Enterprise Admins do not have the required rights to read all mailboxes. See KB 821897 for information on granting permissions (that one is for Exchange 2003, KB 262054 is for Exchange 2000).

Third, you have to modify the end of the script to include the OU's you want to check. It would be trivial to modify this to check all OU's, but that isn't what I need in my environment, so that isn't what the script does. :-)

Fourth, specify the name of any Exchange server in the organization for “StrServerName“.

Fifth, I don't claim originality. Various piece parts of this script came from all over. I just put it together...

 

Option Explicit

'On Error Resume Next

Const StrServerName = “server“

Dim oRootDSE ' (ActiveDs.IADs) directory services root object
Dim varDomainNC ' (Variant) the domain naming context, will be a string of the form "DC=brnets,DC=int"
Dim varConfigNC ' (Variant) the configuration naming context, will be a string of the form "CN=Configuration,DC=brnets,DC=int"
Dim strErr ' global error string
Dim strOrgCN    ' organization common name
Dim strOrgDN    ' organization distinguished name
Dim strDefault  ' default domain name from Exchange's Default Recipient Policy
DIm iCount, iSize, iTotUsers, iNoCount

Sub GetStartupInfo()
    Dim Conn ' As New ADODB.Connection
    Dim Com  ' As New ADODB.Command
    Dim Rs   ' As ADODB.Recordset
    Dim strQuery ' As String
    Dim i
    Dim obj, subobj

    ' Get the configuration naming context.
    Set oRootDSE = GetObject("LDAP://RootDSE")
    varConfigNC = oRootDSE.Get ("configurationNamingContext")
    varDomainNC = oRootDSE.Get ("defaultNamingContext")

    'wscript.echo "Configuration Naming Context: " & varConfigNC
    'wscript.echo "Domain Naming Context: " & varDomainNC

    set Conn = Wscript.CreateObject ("ADODB.Connection")
    set Com  = Wscript.CreateObject ("ADODB.Command")

    ' Open the connection.
    Conn.Provider = "ADsDSOObject"
    Conn.Open "ADs Provider"

    ' Build the query to find the organization.
    strQuery = "<LDAP://" & varConfigNC & ">;(objectCategory=msExchOrganizationContainer);name,cn,distinguishedName;subtree"

    Com.ActiveConnection = Conn
    Com.CommandText = strQuery
    Set Rs = Com.Execute

    strOrgCN = ""
    strOrgDN = ""

    ' Iterate through the results.
    While Not Rs.EOF
 ' Output the name of the organization.
 'wscript.Echo "Org CN: " & Rs.Fields ("cn")
 'wscript.Echo "Org Name: " & Rs.Fields ("name")
 'wscript.Echo "Org DN: " & Rs.Fields ("distinguishedName")
 strOrgCN = Rs.Fields ("cn")
 strOrgDN = Rs.Fields ("distinguishedName")
 Rs.MoveNext
    Wend

    ' Done with querying LDAP
    Rs.Close
    Conn.Close
    set Rs = Nothing
    set Com = Nothing
    set Conn = Nothing

    If Len (strOrgDN) = 0 Then
 Wscript.Echo "Cannot continue - cannot find organization distinguished name"
 Wscript.Quit (1)
    End If

    strDefault = ""
    Set obj = GetObject ("LDAP://CN=Default Policy,CN=Recipient Policies," + strOrgDN)
    subobj = obj.Get ("gatewayProxy")
    For Each i In subobj
 If Left (i, 4) = "SMTP" Then
     'wscript.Echo "Default follows"
     strDefault = Right (i, Len(i) - 6)  ' strip SMTP:@
 End If
        'wscript.echo i
    Next

    Set subobj = Nothing
    Set obj = Nothing

    If Len (strDefault) = 0 Then
 Wscript.Echo "Cannot continue - cannot find default SMTP domain"
 Wscript.Quit (1)
    End If
End Sub

Function GetMailBoxSize (ByVal strServer, ByVal strMailBox, ByRef MessageCount)
 Dim oSession
 Dim oInfoStores
 Dim oInfoStore
 Dim StorageUsed
 Dim NumMessages
 Dim strProfileInfo
 Dim TotalSize, TotalMessages

 GetMailBoxSize = -1
 TotalSize = 0
 TotalMessages = 0

 On Error Resume Next

 ' Create MAPI session object
 Set oSession = CreateObject ("MAPI.Session")
 if Err.Number <> 0 Then
  strErr = "Server: " & strServer & " Mailbox: " & strMailBox & _
   " Error Creating MAPI.Session object (ensure CDO 1.21 installed): " & Err.Number & " (" & Err.Description & ")"
  Exit Function
 End If

 strProfileInfo = strServer & vbLf & strMailBox

 ' Logon to MAPI session
 oSession.Logon , , False, True, , True, strProfileInfo
 if Err.Number <> 0 Then
  strErr = "Server: " & strServer & " Mailbox: " & strMailBox & _
   " Error Logging On: " & Err.Number & " (" & Err.Description & ")"
  Set oSession = Nothing
  Exit Function
 End If

 'Grab the info stores
 Set oInfoStores = oSession.InfoStores
 if Err.Number <> 0 Then
  strErr = "Server: " & strServer & " Mailbox: " & strMailBox & _
   " Error Retrieving Infostores Collection: " & Err.Number & " (" & Err.Description & ")"
  Set oInfoStores = Nothing
  Set oSession = Nothing
  Exit Function
 End If

 'Loop through info stores to find user's mailbox
 For Each oInfoStore In oInfoStores
''  wscript.echo strServer & " " & strMailBox & " " & oInfoStore.Name
  If InStr (1, oInfoStore.Name, "Mailbox - ", 1) <> 0 Then
   StorageUsed = oInfoStore.Fields(&HE080003) '&HE080003 = PR MESSAGE SIZE
   if Err.Number <> 0 Then
    If Err.Number = -2147221219 Then
     Err.Clear
     StorageUsed = 0
     ' no mailbox (prolly a contact record)
     'strErr = ""
     'GetMailBoxSize = 0
     'MessageCount = 0
    Else
     strErr = "Server: " & strServer & " Mailbox: " & strMailBox & _
      " Error Retrieving PR_MESSAGE_SIZE: " & Err.Number & " (" & Err.Description & ")"
     Set oInfoStore = Nothing
     Set oInfoStores = Nothing
     Set oSession = Nothing
     Exit Function
    End If
   End If
   TotalSize = TotalSize + StorageUsed

   NumMessages = oInfoStore.Fields(&H36020003) '&H33020003 = PR CONTENT COUNT
   if Err.Number <> 0 Then
    If Err.Number = -2147221219 Then
     Err.Clear
     NumMessages = 0
     ' no mailbox (prolly a contact record)
     'strErr = ""
     'GetMailBoxSize = 0
     'MessageCount = 0
    Else
     strErr = "Server: " & strServer & " Mailbox: " & strMailBox & _
      " Error Retrieving PR_CONTENT_COUNT: " & Err.Number & " (" & Err.Description & ")"
     Set oInfoStore = Nothing
     Set oInfoStores = Nothing
     Set oSession = Nothing
     Exit Function
    End If
   End If
   TotalMessages = TotalMessages + NumMessages

   'WScript.Echo "Storage Used in " & oInfoStore.Name & " (bytes): " & StorageUsed
   'WScript.Echo "Number of Messages: " & NumMessages
  End If
 Next

 ' Log off
 oSession.Logoff

 ' Clean Up Memory
 Set oInfoStore = Nothing
 Set oInfoStores = Nothing
 Set oSession = Nothing

 MessageCount = TotalMessages
 GetMailBoxSize = TotalSize
End Function

Function List_Users (DomainName, exchDomainName)
    ' Example: Call List_users ("CN=Users,DC=brnets,DC=local", "brnets.com")
    Dim objUser ' As IADsUser
    Dim objContainer ' As IADsContainer
    Dim objMailbox ' As CDOEXM.IMailboxStore
    Dim objR
    Dim i ' As Long
    Dim inx ' As Long
    Dim sz ' As Double
    Dim msgs ' As Double
    Dim name ' As String
Dim obj1, obj2, obj3
Dim iTotCount, iTotSize
Dim str1, str2, str3
Dim iUsers ' count of users with mailboxes

    ' get the container. Note that user information may be located in
    ' other organizational units.
    Set objContainer = GetObject("LDAP://" + DomainName)

 WScript.Echo "Checking " & DomainName

    objContainer.Filter = Array("User")
    i = 0
    iUSers = 0

    For Each objUser In objContainer
        name = objUser.name
'       wscript.echo "name: " & name & " upn: " & objUser.UserPrincipalName & " sam: " & objUser.samAccountName
        name = Right(name, Len(name) - 3)
        Set objMailbox = objUser
        If objMailbox.HomeMDB = "" Then
            'Wscript.echo name + "   (no mailbox)"
        Else
     iUsers = iUsers + 1
            'Wscript.echo name + "   (has mailbox)"
            'Wscript.echo objMailbox.HomeMDB
  sz = GetMailboxSize (StrServerName, name, msgs)

     str1 = name & " (" & objUser.MailNickname & ")"
     If Len (str1) < 40 Then
  str1 = str1 & space (40 - Len(str1))
     Else
  str1 = Left (str1, 40)
     End If

     str2 = FormatNumber (sz, 0)
     If Len (str2) < 14 then
  str2 = space (14 - Len(str2)) & str2
     End If

     If sz < 0 Then 
  WScript.Echo str1 & "  " & str2 & "  " & strErr
     Else
  str3 = FormatNumber (msgs, 0)
  If Len (str3) < 8 Then
   str3 = space (8 - Len (str3)) & str3
  End If

  WScript.Echo str1 & "  " & _
      str2 & "  " & str3
  iTotCount = iTotCount + msgs
  iTotSize = iTotSize + sz
     End If
        End If
        i = i + 1
    Next

 iCount = iCount + iTotCount
 iSize  = iSize  + iTotSize
 iTotUsers = iTotUsers + iUsers

 WScript.Echo "Total for " & DomainName & " (" & iUsers & " users)"
 str1 = space (40)
 str2 = FormatNumber (iTotSize, 0)
 If Len (str2) < 14 then
  str2 = space (14 - Len(str2)) & str2
 End If

 str3 = FormatNumber (iTotCount, 0)
 If Len (str3) < 8 Then
  str3 = space (8 - Len (str3)) & str3
 End If

 WScript.Echo str1 & "  " & str2 & "  " & str3
 i = (100 * 1024 * 1024) * iUsers
 If iTotSize > i Then
  WScript.Echo "*** Attention: Account overage of " & _
   FormatNumber (iTotSize - i, 0) & " bytes"
 End If
 WScript.Echo " "
 WScript.Echo " "
End Function

 Call GetStartupInfo()

 Call List_Users ("CN=Users," + varDomainNC, strDefault)

  iNoCount = iTotUsers
 Call List_Users ("OU=OldClient1," + varDomainNC, strDefault)

 Call List_Users ("OU=Client1,OU=Hosting," + varDomainNC, strDefault)
 Call List_Users ("OU=Client2,OU=Hosting," + varDomainNC, strDefault)
 Call List_users ("OU=Client3,OU=Hosting," + varDomainNC, strDefault)
 Wscript.Echo "Overall Total (All Domains and OUs)"
 WScript.Echo FormatNumber (iSize, 0) & " bytes, " & FormatNumber (iCount, 0) & " messages, " & iTotusers & " users (" & (iTotUsers - iNoCount) & " billable)"

Published Tuesday, November 13, 2007 5:51 PM by michael
Filed under: , ,

Comments

Tuesday, November 13, 2007 6:04 PM by Michael's meanderings...

# A Script for Getting Mailbox Sizes (using WMI)

Originally published July 26, 2004 In this post I provided a script for getting mailbox sizes. One of

Tuesday, November 13, 2007 9:02 PM by Michael's meanderings...

# A Script for Getting Mailbox Sizes (using WMI in PowerShell)

Originally published June 28, 2007 This post and the script is Exchange 2003 friendly. As long as you

Sunday, January 18, 2009 9:24 AM by csvde export mailbox size | keyongtech

# csvde export mailbox size | keyongtech

Pingback from  csvde export mailbox size | keyongtech