Collect number of MBs WA

Collect_number_of_mailboxes_per_server.WriteAction (WriteActionModuleType)

Element properties:

TypeWriteActionModuleType
IsolationAny
AccessibilityInternal
RunAsSystem.PrivilegedMonitoringAccount
InputTypeSystem.BaseData

Member Modules:

ID Module Type TypeId RunAs 
Script WriteAction Microsoft.Windows.ScriptWriteAction Default

Overrideable Parameters:

IDParameterTypeSelectorDisplay NameDescription
TimeoutSecondsint$Config/TimeoutSeconds$Timeout Seconds

Source Code:

<WriteActionModuleType ID="Collect_number_of_mailboxes_per_server.WriteAction" Accessibility="Internal" RunAs="System!System.PrivilegedMonitoringAccount" Batching="false">
<Configuration>
<xsd:element name="TargetNetbiosComputer" type="xsd:string"/>
<xsd:element name="TargetNetbiosDomain" type="xsd:string"/>
<xsd:element name="TimeoutSeconds" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="int"/>
</OverrideableParameters>
<ModuleImplementation Isolation="Any">
<Composite>
<MemberModules>
<WriteAction ID="Script" TypeID="Windows!Microsoft.Windows.ScriptWriteAction">
<ScriptName>Collect_number_of_mailboxes_per_server.vbs</ScriptName>
<Arguments>$Config/TargetNetbiosComputer$ $Config/TargetNetbiosDomain$</Arguments>
<ScriptBody><Script>
'Copyright (c) Microsoft Corporation. All rights reserved.
'*************************************************************************
' $ScriptName: "Common" $
'
' Purpose: To have one place for common stuff across various Exchange VBScripts
'
' $File: Common.vbs $
'*************************************************************************
' Option Explicit

SetLocale("en-us")

Dim EVENT_SOURCE
EVENT_SOURCE = "Exchange MOM"

'=============
'Event Type Constants
'=============
Const EVENT_TYPE_SUCCESS = 0
Const EVENT_TYPE_ERROR = 1
Const EVENT_TYPE_WARNING = 2
Const EVENT_TYPE_INFORMATION = 4

'=============
'Error Constants
'=============
Const ERROR_FILE_NOT_FOUND = -2147024894 'win32 error: 0x80070002

'=============
'Other Constants
'=============
Const MAX_LONG = 2147483647
Const MIN_LONG = -2147483648

'=============
'Initialize MOM Scripting Variables
'=============
Dim oAPI
Set oAPI = CreateObject("Mom.ScriptAPI")
If Err &lt;&gt; 0 Then
Wscript.Quit -1
End If

'=============
'Helper methods
'=============
' Method: CreateEvent
' Description: Logs Event
' Parameters: source, eventId, eventtype(error/warning/info/success), errormsg
'=============
Sub CreateEvent(lngEventID, lngEventType, strMsg)
Call oAPI.LogScriptEvent(EVENT_SOURCE, lngEventID, lngEventType, strMsg)
End Sub

'=============
' Method: HResultToString
' Description: Returns hresult value in string format 0x00000000(0)
' Parameters: hresult
'=============
Function HResultToString(hresult)
HResultToString = "0x" &amp; Hex(hresult) &amp; "(" &amp; hresult &amp; ")"
End Function

'=============
' Method: RegRead
' Description: Returns registry location value
' Parameters: strKey
'=============
Function RegRead(strKey)
On Error Resume Next
RegRead = "..."

Dim objShell
Set objShell = CreateObject("WScript.Shell")
RegRead = objShell.RegRead(strKey)
Set objShell = Nothing
End Function

'=============
' Method: ConvertDateTime
' Description: Returns datetime as formatted string
' Parameters: dtDateTime
'=============
Function ConvertDateTime(dtDateTime)
Dim objDate, objTime
objDate = DateSerial(Left(dtDateTime, 4), Mid(dtDateTime, 5, 2), Mid(dtDateTime, 7, 2))
objTime = TimeSerial(Mid(dtDateTime, 9, 2), Mid(dtDateTime, 11, 2), Mid(dtDateTime, 13, 2))

ConvertDateTime = FormatDateTime(objDate) &amp; " " &amp; FormatDateTime(objTime)
End Function

'=============
' Method: IsWMIRunning
' Description: Returns true/false
' Parameters: -
'=============
Function IsWMIRunning()
Dim objWMI

On Error Resume Next
Set objWMI = GetObject("winmgmts:root\cimv2")
If Err Then
IsWMIRunning = False
CreateEvent _
9013, _
EVENT_TYPE_ERROR, _
"The 'Windows Management Instrumentation' service (WinMgmt.exe) was not running when MOM tried to run a script that is dependent on this service. Check if the start up mode of this service is not set to 'disabled'."
Else
IsWMIRunning = True
End If

End Function

'=============
' Method: WMIExecQuery
' Description: Returns an object of type SWbemObjectSet
' Parameters:
' sNamespace - A WMI Namespace (ex. winmgmts:\\COMPUTERNAME\ROOT\cimv2).
' sQuery - A SQL Query (ex. SELECT * FROM Win32_OperatingSystem)
' iAlert - To echo/raise error
'=============
Function WMIExecQuery(sNamespace, sQuery, iAlert)
Dim oWMI, oQuery
Dim nErrNumber, sErrDescription
Dim nInstanceCount

On Error Resume Next
Set oWMI = GetObject(sNamespace)
On Error Goto 0

If IsEmpty(oWMI) And iAlert &lt;&gt; 0 Then
WScript.Echo "Unable to open WMI Namespace " &amp; sNamespace
Err.Raise 9100, "Unable to open WMI Namespace " &amp; sNamespace, "Check to see if the WMI service is enabled and running, and ensure this WMI namespace."
End If

On Error Resume Next
Set oQuery = oWMI.ExecQuery(sQuery)
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0

If (IsEmpty(oQuery) Or nErrNumber &lt;&gt; 0) And iAlert &lt;&gt; 0 Then
WScript.Echo "The Query '" &amp; sQuery &amp; "' returned an invalid result set. Error:" &amp; nErrNumber &amp; ", " &amp; sErrDescription &amp; "."
Err.Raise 9100, "The Query '" &amp; sQuery &amp; "' returned an invalid result set.", "Please check to see if this is a valid WMI Query. Error:" &amp; nErrNumber &amp; ", " &amp; sErrDescription &amp; "."
End If

'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oQuery.Count
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0

If nErrNumber &lt;&gt; 0 And iAlert &lt;&gt; 0 Then
WScript.Echo "The Query '" &amp; sQuery &amp; "' did not return any valid instances. Error:" &amp; nErrNumber &amp; ", " &amp; sErrDescription &amp; "."
Err.Raise 9100, "The Query '" &amp; sQuery &amp; "' did not return any valid instances.", "Please check to see if this is a valid WMI Query. Error:" &amp; nErrNumber &amp; ", " &amp; sErrDescription &amp; "."
End If

Set WMIExecQuery = oQuery
Set oQuery = Nothing
Set oWMI = Nothing
End Function

'=============
' Method: IsRunningAsSystem
' Description: Returns true/false
' Parameters: -
' Comments: If IsRunningAsSystem is False the caller should check if there is any error (If Err Then ...).
'=============
Function IsRunningAsSystem
Dim WshNetwork
Dim WMISystemAcct

IsRunningAsSystem = False

Set WshNetwork = CreateObject("WScript.Network")

' Use the well-known SID of the system account ("S-1-5-18") to get the correspondent object
Set WMISystemAcct = GetObject("WinMgmts:root/cimv2:Win32_SID='S-1-5-18'")

' WshNetwork.UserName gives the account running the current thread
' WMISystemAcct.AccountName gets the localized name of the system account

' No worries with string case in the comparsion below since, if the account is
' system, the name is extracted from the same location for both objects
If WshNetwork.UserName = WMISystemAcct.AccountName Then
IsRunningAsSystem = True
End If
End Function

'=============
'=============
'Exchange specific Helper methods
'=============
'=============

'=============
' Method: GetNamingContext
' Description: Returns propertyValue from rootDSE object
' Parameters: strPropertyName
'=============
Function GetNamingContext(strPropertyName)
GetNamingContext = ""

Dim IADsRootDSE
Set IADsRootDSE = GetObject("LDAP://rootDSE")

GetNamingContext = IADsRootDSE.Get(strPropertyName)
Set IADsRootDSE = Nothing
End Function

'=============
' Method: GetRootGC
' Description: Returns RootGC
' Parameters: -
'=============
Function GetRootGC()
Dim oGCCollection, oGC
Set oGCCollection = GetObject("GC:")
For each oGC in oGCCollection
Set GetRootGC = oGC
Next
End Function

'=============
' Method: GetCNValue
' Description: -
' Parameters: iOcurr, strData
'=============
Function GetCNValue(iOcurr, strData)
GetCNValue = GetTokValue(iOcurr, "CN=", ",", strData)
End Function

'=============
' Method: GetTokValue
' Description: -
' Parameters: iOcurr, strStartTok, strEndTok, strData
'=============
Function GetTokValue(iOcurr, strStartTok, strEndTok, strData)
Dim iIni, iEnd, iTokLen
iTokLen = Len(strStartTok)
iIni = 1
While iOcurr &gt; 0 ' Skip to the desired occurence
iIni = InStr(iIni, strData, strStartTok, vbTextCompare) + iTokLen
iOcurr = iOcurr - 1
WEnd
iEnd = InStr(iIni, strData, strEndTok, vbTextCompare)
GetTokValue = Mid(strData, iIni, (iEnd - iIni))
End Function

'=============
' Format Constants
'=============
Dim REC_DELIM, INFO_DELIM, IDENT
REC_DELIM = vbCr
INFO_DELIM = vbCr &amp; vbCr
IDENT = " "

'=============
' Method: OutputInfo
' Description: -
' Parameters: strValues, strProps, iPropsFrom, iLevel, blnHierarchical
' Remarks: Very similar to OutDiskInfo sub in Disk_Space_Problem.vbs
'=============
Function OutputInfo(strValues, strProps, iPropsFrom, iLevel, blnHierarchical)
Dim arrValues, arrProps, strLvl
Dim i

If strValues = "" Then Exit Function

On Error Resume Next
OutputInfo = ""
arrValues = Split(strValues, ";")
arrProps = Split(strProps, ",")

While iLevel &gt; 0
strLvl = strLvl &amp; IDENT
iLevel = iLevel - 1
WEnd

For i = iPropsFrom To UBound(arrProps)
OutputInfo = OutputInfo &amp; strLvl &amp; arrProps(i) &amp; ": " &amp; arrValues(i) &amp; REC_DELIM
If i = iPropsFrom and blnHierarchical Then strLvl = strLvl &amp; IDENT
Next
On Error GoTo 0
End Function


'Copyright (c) Microsoft Corporation. All rights reserved.
'*************************************************************************
' $ScriptName: "Common ADO stuff" $
'
' Purpose: To have one place for common stuff across various Exchange VBScripts:
' Disk_Space_Problem
' Verify_If_SSL_Should_Be_Required
' Collect_Public_Folder_Statistics
' Verify_Test_Mailboxes
' Collect_Number_Of_Mailboxes_Per_Server
' Collect_Server_Information
'
' $File: Common_ADO.vbs $
'*************************************************************************
Dim objADOConn, objADOComm

'=========================================================
Sub InitializeGlobalObjects()
' Create the ADO objects to run the query
Set objADOConn = CreateObject("ADODB.Connection")
objADOConn.Provider = "ADsDSOObject"
objADOConn.Open "AD Provider"

Set objADOComm = CreateObject("ADODB.Command")
Set objADOComm.ActiveConnection = objADOConn
objADOComm.Properties("Page Size") = 1000 ' The page size needs to be specified or the function NumberOfEntries will fail
objADOComm.Properties("Timeout") = 30 'seconds
objADOComm.Properties("Cache Results") = false 'do not cache the result set
End Sub

'=========================================================
Sub ReleaseGlobalObjects()
Set objADOConn = Nothing
Set objADOComm = Nothing
End Sub

'=========================================================
Sub GetADSIInfo(strProps, strLDAPQuery, strRes, strFieldDelim, strRecordDelim)
Dim objQueryResult, objIADs, strProp, Values, strValue

objADOComm.CommandText = strLDAPQuery
Set objQueryResult = objADOComm.Execute

While not objQueryResult.eof
Set objIADs = GetObject(objQueryResult.fields(0))

For each strProp in Split(strProps, ",")
On Error Resume Next
Values = objIADs.Get(strProp)
If Err = &amp;h8000500D Then ' value not in the property cache
objIADs.GetInfoEx Array(strProp), 0
Values = objIADs.Get(strProp)
End If
On Error Goto 0

Select Case VarType(Values)
Case 9 ' Object
If Values Is Nothing Then
strValue = "&lt;not set&gt;"
Else
strValue = Values
End If
Case 8204 ' VT_ARRAY + VT_VARIANT
strValue = CStr(NumberOfEntries(objIADs.AdsPath, strProp))
Case Else
strValue = Values
End Select
strRes = strRes &amp; strValue &amp; strFieldDelim
Next

strRes = Left(strRes, Len(strRes) - 1) &amp; strRecordDelim
objQueryResult.MoveNext
WEnd
End Sub

'=========================================================
Function NumberOfEntries(ldapPath, ldapProp)
Dim rs, iStart

NumberOfEntries = 0
iStart = 0

Do
objADOComm.CommandText = "SELECT '" &amp; ldapProp &amp; ";range=" &amp; iStart &amp; "-*' FROM '" &amp; Replace(ldapPath, "'", "''") &amp; "'"
Set rs = objADOComm.Execute()
If (Not rs.EOF) Then
rs.MoveFirst()
iStart = iStart + objADOComm.Properties("Page Size")
If 8204 = VarType(rs.Fields(0).Value) Then
NumberOfEntries = NumberOfEntries + UBound(rs.Fields(0).Value) - LBound(rs.Fields(0).Value) + 1
Else
NumberOfEntries = iStart
End If
End If
Loop While (NumberOFEntries = iStart) And (Not rs.EOF) And (objADOComm.Properties("Page Size") &gt; 0)

End Function



'Copyright (c) Microsoft Corporation. All rights reserved.
'*************************************************************************
' $ScriptName: "Collect number of mailboxes per server" $
'
' Purpose - To collect the number of mailboxes per database, storage group and server
'
' $File: Collect_number_of_mailboxes_per_server.vbs $
'*************************************************************************
'Event ID Constants
EVENT_SOURCE = "Exchange MOM"
Const EX2K_MAILBOXES_EVENT_ID = 9010
Const ERROR_GETTING_INFO_EVENT_ID = 9012
Const ERROR_GETTING_INFO_MSG = "The Active Directory returned invalid information when a MOM script tried to get the number of Exchange mailboxes"

REC_DELIM = vbCr

' Global objects
Dim strOutput
Dim oArgs, TargetNetbiosDomain, TargetNetbiosComputer

Set oArgs = WScript.Arguments
if oArgs.Unnamed.Count &lt; 2 Then
Call WScript.Quit(-1)
end if

TargetNetbiosComputer = oArgs(0)
TargetNetbiosDomain = oArgs(1)

GetNumberOfMailboxesFromAD TargetNetbiosDomain, TargetNetbiosComputer, strOutput

' -- Subs -----------------------------------------------------------------------
Sub GetNumberOfMailboxesFromAD(strDomain, strComputer, strOutput)
Dim strDN, strSearchFilter, strScope, strSrvProps, strSrvs, strSrv, strQuery
Dim strSGProps, strSGs, strSG
Dim strMDBProps, strMDBs, strMDB

Dim iSrvMDBs, iSGMDBs, arrData, blnMDB, iAux

InitializeGlobalObjects

strDN = "&lt;LDAP://" &amp; GetNamingContext("configurationNamingContext") &amp; "&gt;"
strSearchFilter = "(&amp;(objectCategory=msExchExchangeServer)(cn=" &amp; strComputer &amp; "))"
strScope = "subTree"
strSrvProps = "distinguishedName,name"
strSrvs = ""

strQuery = strDN &amp; ";" &amp; strSearchFilter &amp; ";*;" &amp; strScope

GetADSIInfo strSrvProps, strQuery, strSrvs, ";", REC_DELIM

For each strSrv in Split(strSrvs, REC_DELIM)
If strSrv = "" Then Exit For

' Get the Storage group info
strDN = "&lt;LDAP://" &amp; Left(strSrv,InStr(strSrv,";") - 1) &amp; "&gt;"
strSearchFilter = "(&amp;(objectCategory=msExchStorageGroup)(|(!msExchRestore=*)(!msExchRestore=TRUE)))"
strQuery = strDN &amp; ";" &amp; strSearchFilter &amp; ";*;" &amp; strScope
strSGProps = "distinguishedName,name"
strSGs = ""

GetADSIInfo strSGProps, strQuery, strSGs, ";", REC_DELIM
iSrvMDBs = 0

For each strSG in Split(strSGs, REC_DELIM)
If strSG = "" Then Exit For

' Get the Private MDBs info
strDN = "&lt;LDAP://" &amp; Left(strSG,InStr(strSG,";") - 1) &amp; "&gt;"
strSearchFilter = "(objectCategory=msExchPrivateMDB)"
strQuery = strDN &amp; ";" &amp; strSearchFilter &amp; ";*;" &amp; strScope
strMDBProps = "name,homeMDBBL"
strMDBs = ""

GetADSIInfo strMDBProps, strQuery, strMDBs, ";", REC_DELIM

iSGMDBs = 0
blnMDB = False
For each strMDB in Split(strMDBs, REC_DELIM)
If strMDB = "" Then Exit For

arrData = Split(strMDB, ";")

On Error Resume Next
iAux = CLng(arrData(1))
If Err Then
iSGMDBs = iSGMDBs + 0
CreateEvent ERROR_GETTING_INFO_EVENT_ID, EVENT_TYPE_ERROR, ERROR_GETTING_INFO_MSG
Else
iSGMDBs = iSGMDBs + iAux
End If
On Error Goto 0

blnMDB = True
strOutput = ";;;;" &amp; arrData(0) &amp; ";" &amp; arrData(1) &amp; ";" &amp; REC_DELIM &amp; strOutput
Next

If blnMDB Then
strOutput = ";;" &amp; Right(strSG,Len(strSG) - InStr(strSG,";")) &amp; ";" &amp; iSGMDBs &amp; ";" &amp; Right(strOutput, Len(strOutput) - 4)
iSrvMDBs = iSrvMDBs + iSGMDBS
Else
strOutput = ";;" &amp; Right(strSG,Len(strSG) - InStr(strSG,";")) &amp; ";" &amp; iSGMDBs &amp; ";;;" &amp; REC_DELIM &amp; strOutput
End If
Next

If strOutput &lt;&gt; "" Then
strOutput = strDomain &amp; "\" &amp; Right(strSrv,Len(strSrv) - InStr(strSrv,";")) &amp; ";" &amp; iSrvMDBs &amp; ";" &amp; Right(strOutput, Len(strOutput) - 2)
Else
strOutput = strDomain &amp; "\" &amp; Right(strSrv,Len(strSrv) - InStr(strSrv,";")) &amp; ";" &amp; iSrvMDBs &amp; ";;;;;"
End If

CreateEvent EX2K_MAILBOXES_EVENT_ID, EVENT_TYPE_INFORMATION, strOutput
strOutput = ""
Next

ReleaseGlobalObjects
End Sub

</Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</WriteAction>
</MemberModules>
<Composition>
<Node ID="Script"/>
</Composition>
</Composite>
</ModuleImplementation>
<InputType>System!System.BaseData</InputType>
</WriteActionModuleType>