Query for a mailbox’s size and quota

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

6 thoughts on “Query for a mailbox’s size and quota

  1. This is Great!! I translated it into C# so I could use it for a ASP.NET site and saved me a lot of time. Thanks a lot!

  2. Thanks and great script, Can you point me in the right direction in getting the script to display the Storage Group Name and Mail Store Name, aswell please.

    Thanks Steve

  3. The storage group and database name are implicitly known since they are contained in the homemdb attribute, which was retrieved in line 52. To parse that, convert the string into an array; the database will be at index 0, and the storage group at index 1. This code does it:

    arrHomeMdb = Split(homemdb, “,”)
    strDB = Mid(arrHomeMdb(0),4)
    strSG = Mid(arrHomeMdb(1),4)

    You can then add this information to the message box at line 138 (and to the shell output, if you want, at lines 135-137).

  4. A slight mod was required to get Scott’s storage group code to work:

    arrHomeMdb = Split(objResults.Fields(“homemdb”).value,”,”)
    strDB = Mid(arrHomeMdb(0),4)
    strSG = Mid(arrHomeMdb(1),4)

Leave a Reply

Your email address will not be published. Required fields are marked *

*