'User Configurable settings
'This string contains your base domain LDAP string
strLDAPString =LDAP://dc=YOUR,dc=WINDOWS,dc=DOMAIN,dc=com

'Declare variables
Dim oSession
Dim oInfoStores
Dim oInfoStore
Dim StorageUsed
Dim NumMessages
Dim strProfileInfo
Dim sMsg

'Input and Output files
Set iFSO = CreateObject("Scripting.FilesyStemObject")
Set oFSO = CreateObject("Scripting.FilesyStemObject")

'Input file (Change this if you change the input file name)
Set ifile = iFSO.OpenTextFile("userlist.txt")

'Output file
Set ofile = iFSO.CreateTextFile("Mailbox Details.csv")
ofile.writeline "UserName,FullName,Exchange Server,Storage Used (Bytes),Total Items"

'Set up AD stuff
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")

'Loop through each user one by one.
Do until ifile.AtEndOfLine
struser = ifile.ReadLine

'Connect to AD and find out where the users mailbox is located. Also grabs a lot of other details.
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
'Change this if you change the domain
objCommand.CommandText = _
"SELECT Name, adspath FROM '" & strLDAPString & "' WHERE objectCategory='user' " & "AND sAMAccountName='" & struser & "'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
strpath = objRecordSet.Fields("ADsPath").Value
set objuser = GetObject(strPath)

'If there is no error, then get the details.
If Err.Number = 0 then
strExchangeServer = (Mid(objuser.msExchHomeServerName,(InStrRev(objuser.msExchHomeServerName,"=")+ 1)))
strFullName = objuser.fullname
Else
wscript.echo "Error User Account May Not Exist or Corrupt AD Info For Account"
end if
objConnection.Close

On Error Resume Next

'Create MAPI Session object.
Set oSession = CreateObject("MAPI.Session")
if Err.Number <> 0 Then
sMsg = "Error creating MAPI.Session."
sMsg = sMsg & "Make sure CDO 1.21 is installed. (Run it on an Exchange server is probably easiest)"
sMsg = sMsg & Err.Number & " " & Err.Description
WScript.Echo sMsg
End If

'Build logon string
strProfileInfo = strExchangeServer & vbLf & strUser

'Log on to mailbox
oSession.Logon , , False, True, , True, strProfileInfo
if Err.Number <> 0 Then
Set oSession = Nothing
End If

'Grab the information stores.
Set oInfoStores = oSession.InfoStores
if Err.Number <> 0 Then

Set oInfoStores = Nothing
Set oSession = Nothing
End If

'Loop through information stores to find the user's mailbox.
For Each oInfoStore In oInfoStores
If InStr(1, oInfoStore.Name, "Mailbox - ", 1) <> 0 Then
'&HE080003 = PR_MESSAGE_SIZE
StorageUsed = oInfoStore.Fields(&HE080003)
if Err.Number <> 0 Then
sMsg = "Error retrieving PR_MESSAGE_SIZE: "
sMsg = sMsg & Err.Number & " " & Err.Description
WScript.Echo sMsg
WScript.Echo "Server: " & obArgs.Item(0)
WScript.Echo "Mailbox: " & obArgs.Item(1)
Set oInfoStore = Nothing
Set oInfoStores = Nothing
Set oSession = Nothing
End If

'&H33020003 = PR_CONTENT_COUNT
NumMessages = oInfoStore.Fields(&H36020003)

if Err.Number <> 0 Then

sMsg = "Error Retrieving PR_CONTENT_COUNT: "
sMsg = sMsg & Err.Number & " " & Err.Description
Set oInfoStore = Nothing
Set oInfoStores = Nothing
Set oSession = Nothing
End If

strInfoStore = oInfoStore.Name
strStorageUsed = StorageUsed
strTotalItems = NumMessages
End If
Next

' Log off.
oSession.Logoff

' Clean up memory.
Set oInfoStore = Nothing
Set oInfoStores = Nothing
Set oSession = Nothing

'Echo to screen for people who are impatient and like to see what is going on
wscript.echo strUser &","& strFullName &","& strExchangeServer &"," & strStorageUsed &","& strTotalItems

'Write to CSV file
ofile.writeline strUser &","& strFullName &","& strExchangeServer &"," & strStorageUsed &","& strTotalItems

loop