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)"