Submitted By: Marcus Rose

Lists all the Exchange Servers in the your Active Directory forest.

Visual Basic
Edit|Remove
arrExServerName = EnumerateXchSvr
 For j = 0 To Ubound(arrExServerName)
 	strExServerName = arrExServerName(j)
 	WScript.Echo strExServerName
 Next

Function EnumerateXchSvr
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnection = objConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strConfigurationNC = objRootDSE.Get("configurationNamingContext")
strSchemaNC = objRootDSE.Get("schemaNamingContext")
strExchangeCN = "LDAP://cn=Microsoft Exchange,cn=Services" & "," & strConfigurationNC
strCMDTxt = "Select distinguishedName, name from '" & strExchangeCN & " 'where objectCategory='CN=ms-Exch-Exchange-Server," & strSchemaNC & "'"
objCommand.CommandText = strCMDTxt
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30 
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

Set objRecordSet = objCommand.Execute
If objRecordSet.RecordCount > 0 Then
	objRecordSet.MoveFirst
Else
	WScript.Echo "no records found"
	WScript.Quit
End if
ReDim arrXchSvr(0)
i = 0
Do Until objRecordSet.EOF
	strXchSvr = objRecordSet.Fields("Name").Value
    arrXchSvr(i) = strXchSvr
    i = i + 1 
    redim preserve arrXchSvr(i)
    objRecordSet.MoveNext
Loop
EnumerateXchSvr = arrXchSvr
End Function