1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
|
'===============================================================
' Purpose: Display each Exchange_Mailbox found for Exchange server,
' and show all properties on the Exchange_Mailbox
' objects. Output is meant to be imported into Excel. It will give insight in mailbox sizes,
' usage etc.
' Note: check the SelfADSI website for great info about the user object: http://www.selfadsi.org/
' Change: cComputerName [string] the computer to access
' Output: Displays the name of each Exchange_Mailbox and properties
' Author: Paul Weterings
' www.servercare.nl
' Date : feb 2006
' Rev : feb 2007 v1.2. added mailbox-type
' Rev : jul 2009 v1.3 change date handeling and comma delimitation, added e-mail and user disabled info
' Rev : aug 2009 v1.4 fixed small typo
' Version 1.4
'===============================================================
option explicit
' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
Const ADS_NAME_TYPE_DISPLAY = 4
On Error Resume Next
Const cWMINameSpace = "root/MicrosoftExchangeV2"
Const cWMIInstance = "Exchange_Mailbox"
Dim strWinMgmts ' Connection string for WMI
Dim objWMIExchange ' Exchange Namespace WMI object
Dim listExchange_Mailboxs ' ExchangeLogons collection
Dim objExchange_Mailbox ' A single ExchangeLogon WMI object
Dim strEmail, strUserInfo, strServerName, objUser, objTrans, strUserDN
'See WMIDateToString function
SetLocale(1043)
Set objUser = CreateObject("Scripting.Dictionary")
If WScript.Arguments.Count > 0 Then
strServerName = WScript.Arguments.Item(0)
' WScript.echo "Checking Exchange server: " & strServername
' Create the object string, indicating WMI (winmgmts), using the
' current user credentials (impersonationLevel=impersonate),
' on the computer specified in the variabele strServerName, and
' using the CIM namespace for the Exchange provider.
strWinMgmts = "winmgmts:{impersonationLevel=impersonate}!//"& strServerName&"/"&cWMINameSpace
Set objWMIExchange = GetObject(strWinMgmts)
' Verify we were able to correctly set the object.
If Err.Number <> 0 Then
WScript.Echo "ERROR: Unable to connect to the WMI namespace." & Err.Description
Err.Clear
Else
'
' The Resources that currently exist appear as a list of
' Exchange_Mailbox instances in the Exchange namespace.
Set listExchange_Mailboxs = objWMIExchange.InstancesOf(cWMIInstance)
'
' Were any Exchange_Mailbox Instances returned?
If (listExchange_Mailboxs.count > 0) Then
' If yes, do the following:
' Print header and Iterate through the list of Exchange_Mailbox objects.
WScript.echo "User name; Days not used; Items; Mb Size; Mailbox store; Mailbox Type; User Disabled; Primary E-Mail"
For Each objExchange_Mailbox in listExchange_Mailboxs
objUser = null
strUserInfo = ""
' Use the NameTranslate object to convert the Display Name to the
' Distinguished Name required for the LDAP provider.
' See http://www.rlmueller.net/NameTranslateFAQ.htm
Set objTrans = CreateObject("NameTranslate")
' Initialize NameTranslate by locating the Global Catalog.
objTrans.Init ADS_NAME_INITTYPE_GC, ""
' Use the Set method to specify the NT format of the object name.
objTrans.Set ADS_NAME_TYPE_DISPLAY, objExchange_Mailbox.MailboxDisplayName
' Use the Get method to retrieve the RPC 1779 Distinguished Name.
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
' WScript.Echo "checking: " & objExchange_Mailbox.MailboxDisplayName
' Bind to the user object in Active Directory with the LDAP provider.
Set objUser = GetObject("LDAP://" & strUserDN)
If Err.Number <> 0 Then
WScript.Echo "Problem getting object" & strUserDN & "Error: " & Err.Nr & " : " & Err.Description
Err.Clear
End If
'Now lets display all the information found, note that only the last line uses the translation.
'skip the crappy AD names that are very long strings & most likely not users
if len(objExchange_Mailbox.MailboxDisplayName) < 40 Then
'Build user information string
strUserInfo = objExchange_Mailbox.MailboxDisplayName & _
";" & DateValue(Now) - DateValue(WMIDateToString(objExchange_Mailbox.LastLogonTime)) &_
";" & objExchange_Mailbox.TotalItems & _
";" & objExchange_Mailbox.Size & _
";" & objExchange_Mailbox.StoreName &_
";" & objUser.Title &_
";" & objUser.AccountDisabled
' Find the users primary SMTP address, we need to walk the array of addresses
For Each strEmail in objUser.proxyAddresses
if InStr(strEmail, "SMTP") > 0 then 'caps are used for primary addresses
strUserInfo = strUserinfo & ";" & Right(strEmail, Len(strEMail) - 5)
End If
Next
if Len(strUserInfo) > 1 Then
'WScript.echo strUserInfo
WScript.StdOut.Write objExchange_Mailbox.MailboxDisplayName
'Not mandatory if user never logged on
If Len(objExchange_Mailbox.LastLogonTime) > 0 Then
WScript.StdOut.Write ";" & DateValue(Now) - DateValue(WMIDateToString(objExchange_Mailbox.LastLogonTime))
Else
WScript.StdOut.Write "; -"
End If
WScript.StdOut.Write ";" & objExchange_Mailbox.TotalItems
WScript.StdOut.Write ";" & objExchange_Mailbox.Size
WScript.StdOut.Write ";" & objExchange_Mailbox.StoreName
WScript.StdOut.Write ";" & objUser.Title
WScript.StdOut.Write ";" & objUser.AccountDisabled
For Each strEmail in objUser.proxyAddresses
if InStr(strEmail, "SMTP") > 0 then 'caps are used for primary addresses
'strUserInfo = strUserinfo & ";" & Right(strEmail, Len(strEMail) - 5)
WScript.StdOut.Write ";" & Right(strEmail, Len(strEMail) - 5)
End If
Next
WScript.StdOut.WriteLine
End If
End if
Next
Else
' If no Exchange_Mailbox instances were returned,
' display that.
WScript.Echo "WARNING: No Exchange_Mailbox instances were returned."
End If
End If
Else
WScript.echo "Argument: Servername"
WScript.echo "Where Servername is the NetBIOS name of the Exchange server you want to list"
End If
'******************************************************************************
Function WMIDateToString(dtmDate)
'Note that the string to date conversion routines in VBScript have the annoying habit of being 'self healing'
'meaning: if you are using US notation the month and day will n a different location (month-day-year for US, day-month-year for EUR)
'locale is being used to check what date format is preferred, but VBScript will also check the days/months to see if it goes past 12
'if it that, for that date day is presumed. However, when you convert an array of strings this leads to confusing output: some dates are correct
'but for dates with days less than 12 things will be screwed up.
'Since I'm in Europe, I'm using day-month (7,2 and 5,2) you may want to change this for US dates (5,2 and 7,2 positions)
'additionally I'm forcing locale to use the dutch (1043) settings within the script, for US this is 1033 (see header)
WMIDateToString = Mid(dtmDate, 7, 2) & "/" & _
Mid(dtmDate, 5, 2) & "/" & _
Left(dtmDate, 4) & " "
'Skipping time for now, as I don't need it.
' Mid(dtmDate, 9, 2) & ":" & _
' Mid(dtmDate, 11, 2) & ":" & _
' Mid(dtmDate, 13, 2)
WMIDateToString = CDate(WMIDateToString)
End Function
|
