There are a lot of scripts out there to report a mailbox’s current size and others to report the quota for a mailbox. And some might even do both, but for an entire domain, server, etc. I wanted one that I could use to list a single mailbox’s current size and where it falls within its quota.
This script allows you to find a user based on login name (samAccountName) or email address. If multiple matches are found it will report on all of them. It uses WMI to query Exchange for the mailbox’s current size and then uses LDAP to determine the quota. Since there are multiple places a quota can be set (system policy, server, mailbox), the script factors those in and backtracks to the resulting quota in effect.
The results are output to the screen and to a popup window. And since it is nice to know, it also will display if default or custom limits are in use. This script is nice because you don’t have to customize anything. Just download\copy it and run it.
Option Explicit
Dim objGC, objOU, strADPath
Dim strUserLoginName
Dim objADOCnxn, objADOCmd, strSearchFilter, strReturnAttrib, strSearchDepth, objResults, intMatchingRecords
Dim strUserDisplayName, strRawExchServer, strExchServer
Dim wmiConn, strWQL, wmiColl, wmiObj
Dim mbstore, strquota, stroverquota, strHardLimit, strmbsize, strquotasum
'
' Messages to be displayed if the scripting host is not cscript
'
Const kMessage1 = "Please run this script using CScript."
Const kMessage2 = "This can be achieved by"
Const kMessage3 = "1. Using ""CScript script.vbs arguments"" or"
Const kMessage4 = "2. Changing the default Windows Scripting Host to CScript"
Const kMessage5 = " using ""CScript //H:CScript //S"" and running the script "
Const kMessage6 = " ""script.vbs arguments""."
' Make sure running with CScript
If Not IsHostCscript() Then
Call WScript.echo(kMessage1 & vbCRLF & kMessage2 & vbCRLF & _
kMessage3 & vbCRLF & kMessage4 & vbCRLF & _
kMessage5 & vbCRLF & kMessage6 & vbCRLF)
WScript.quit
End If
' Connect to a global catalog for the forest
Set objGC = GetObject("GC:")
For Each objOU In objGC
strADPath = "<" & objOU.AdsPath & ">"
Next
Set objOU = Nothing
Set objGC = Nothing
WScript.Echo "* Searching within: " & strADPath
' Get input - strUserLoginName
strUserLoginName = InputBox("This will search for the user's mailbox and display its size." & _
vbCrLf & vbCrLf & "Enter a user's login name, or" & vbCrLf & "their primary SMTP address:" & _
vbCrLf & vbCrLf & "(LDAP wildcard characters are supported.)")
If strUserLoginName = "" Then
WScript.Echo "User Canceled"
WScript.Quit
End If
' Use ADO to query on the given user login name
Set objADOCnxn = CreateObject("ADODB.Connection")
objADOCnxn.Provider = "ADsDSOObject"
objADOCnxn.Open "Active Directory Provider"
Set objADOCmd = CreateObject("ADODB.Command")
objADOCmd.ActiveConnection = objADOCnxn
strSearchFilter ="(&(objectCategory=person)(|(mail=" & strUserLoginName & ")(samAccountName=" & strUserLoginName & ")))"
strReturnAttrib = "displayName,msExchHomeServerName,samAccountName,mdbUseDefaults,homemdb,mDBStorageQuota,mDBOverQuotaLimit,mDBOverHardQuotaLimit"
strSearchDepth = "SubTree"
objADOCmd.CommandText = strADPath & ";" & strSearchFilter & ";" & strReturnAttrib & ";" & strSearchDepth
Set objResults = objADOCmd.Execute
intMatchingRecords = objResults.RecordCount
WScript.Echo " AD Search Returned " & intMatchingRecords & " Records" & vbCrLf
If intMatchingRecords < 1 Then
' User name was not found
MsgBox "The specified string was not found!" & vbCrLf & vbCrLf & "No matching user name or SMTP address(es)", 0, "Search Results"
Else
' We found a match, for each record in result set...
Do
strUserDisplayName = objResults.Fields("displayName").value
strRawExchServer = objResults.Fields("msExchHomeServerName").value
' only proceed if the msExchHomeServerName attribute contains an '=' character
If InStr(1, strRawExchServer, "=", vbTextCompare) Then
' Parse out the actual Exchange server name (everything to right of last '=')
strExchServer = Mid(strRawExchServer,InStrRev(strRawExchServer, "=", -1, vbTextCompare) + 1)
' Create a WMI connection to that server
Set wmiConn = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\" & strExchServer & "\root\microsoftexchangev2")
' Search for the display name of the user
WScript.Echo "* Looking for '" & strUserDisplayName & "' on server " & strExchServer
strWQL = "SELECT * FROM Exchange_Mailbox WHERE MailboxDisplayName = '" & strUserDisplayName & "'"
'WScript.Echo " DEBUG " & strWQL
WScript.Echo " Searching... Please wait"
Set wmiColl = wmiConn.ExecQuery(strWQL)
If wmiColl.Count >= 1 Then
' Get quota limits
If objResults.Fields("mDBUseDefaults").value = true Then
Set mbstore = GetObject("GC://" & objResults.Fields("homemdb"))
If mbstore.mDBStorageQuota = "" Then
strquota = "No Quota"
Else
strquota = formatnumber(mbstore.mDBStorageQuota/1024,0)
End if
If mbstore.mDBOverQuotaLimit = "" Then
stroverquota = "No Quota"
Else
stroverquota = formatnumber(mbstore.mDBOverQuotaLimit/1024,0)
End if
If mbstore.mDBOverHardQuotaLimit = "" Then
strHardLimit = "No Quota"
Else
strHardLimit = formatnumber(mbstore.mDBOverHardQuotaLimit/1024,0)
End if
If strquota <> "No Quota" Then
strquotasum = " Storage Quotas (Using store limits):" & vbcrlf
strquotasum = strquotasum & " Warning Limit: " & strquota & " MB" & vbcrlf
strquotasum = strquotasum & " Prohibit Send: " & stroverquota & " MB" & vbcrlf
strquotasum = strquotasum & " Prohibit Receive: " & strHardLimit & " MB" & vbcrlf
Else
strquotasum = "Storage Limits: No Quotas Configured" & vbcrlf
End if
Else
If IsNull(objResults.fields("mDBStorageQuota").value) Then
strquota = "No Quota"
Else
strquota = formatnumber(objResults.fields("mDBStorageQuota").value/1024,0) & " MB"
End if
If IsNull(objResults.fields("mDBOverQuotaLimit").value) Then
stroverquota = "No Quota"
Else
stroverquota = formatnumber(objResults.fields("mDBOverQuotaLimit").value/1024,0) & " MB"
End if
If IsNull(objResults.fields("mDBOverHardQuotaLimit").value) Then
strHardLimit = "No Quota"
Else
strHardLimit = formatnumber(objResults.fields("mDBOverHardQuotaLimit").value/1024,0) & " MB"
End if
strquotasum = " Storage Quotas (Using custom limits):" & vbcrlf
strquotasum = strquotasum & " Warning Limit: " & strquota & vbcrlf
strquotasum = strquotasum & " Prohibit Send: " & stroverquota & vbcrlf
strquotasum = strquotasum & " Prohibit Receive: " & strHardLimit & vbcrlf
End if
' for each mailbox found (should only be one), display the size
For Each wmiObj In wmiColl
WScript.Echo " Found: " & wmiObj.MailboxDisplayName
WScript.Echo " Mailbox Size: " & formatnumber(wmiObj.Size/1024,1) & " MB" & vbCrLf
Wscript.Echo strquotasum
MsgBox " Mailbox: " & strUserDisplayName & vbcrlf & " Size: " & formatnumber(wmiObj.Size/1024,1) & _
" MB" & vbcrlf & vbcrlf & strquotasum, 0, "Search Results"
Next
Else
' No mailbox found
MsgBox "'" & strUserDisplayName & "' mailbox was not found on server " & strExchServer, 0, "Search Results"
End If
Set wmiColl = Nothing
Set wmiConn = Nothing
Else
WScript.Echo "* No Exchange Home Server defined for " & objResults.Fields("samAccountName").value & vbCrLf
End If
'move to the next record in the record set; quit when EOF is true
objResults.MoveNext
Loop until objResults.EOF
End If
Set objResults = Nothing
Set objADOCmd = Nothing
Set objADOCnxn = Nothing
WScript.Echo "Done!"
WScript.Quit
' Determines which program is used to run this script.
' Returns true if the script host is cscript.exe
Function IsHostCscript()
On Error Resume Next
Dim strFullName
Dim strCommand
Dim i, j
Dim bReturn
bReturn = False
strFullName = WScript.FullName
i = InStr(1, strFullName, ".exe", 1)
If i <> 0 Then
j = InStrRev(strFullName, "\", i, 1)
If j <> 0 Then
strCommand = Mid(strFullName, j+1, i-j-1)
If LCase(strCommand) = "cscript" Then
bReturn = True
End If
End If
End If
If Err <> 0 Then
Call WScript.echo("Error 0x" & Hex(Err.Number) & " occurred. " & Err.Description _
& ". " & vbCRLF & "The scripting host could not be determined.")
End If
IsHostCscript = bReturn
End Function
Comments (0) 
Themocracy