'Set up constant for deleting values from multivalued attribute memberOf
Const ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ADS_UF_ACCOUNTDISABLE = 2 'For UserAccountControl
Const strX400Search = "X400"
'______________________________________________________
'Set RootDSE
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomain = objRootDSE.Get("defaultNamingContext")
strADPath = "LDAP://" & strDomain
'wscript.Echo strADPath
Set objDomain = GetObject(strADPath)
'wscript.echo "objDomain: " & objDomain.distinguishedName
'Setup ADODB connection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
'Start procedure
strResult = strResult & VbCrLf & "Domain: " & strDomain & VbCrLf
'******************************************************
'Execute search command to look for Contacts
objCommand.CommandText = _
"<" & strADPath & ">" & ";(&(objectClass=contact)(mail=*))" & ";distinguishedName,displayName,mail,proxyAddresses;subtree"
'Execute search to get Recordset
Set objRecordSet = objCommand.Execute
strResult = strResult & vbCrlf & "##############################################################Contacts"
strResult = strResult & VbCrlf & "#Total Mail Enabled Contacts Found: " & objRecordSet.RecordCount & VbCrlf
AddressCount = 0
While Not objRecordSet.EOF 'Iterate through the search results
strUserDN = objRecordSet.Fields("distinguishedName") 'Get User's distinguished name from Recordset into a string
On Error Resume Next
set objUser= GetObject("LDAP://"& Replace(strUserDN, "/", "\/") & "") 'Use string to bind to user object
If err.Number = 0 Then
strResult = strResult & VbCrlf & "cn: " & objUser.cn
strResult = strResult & VbCrlf & "mail: " & objUser.mail
arrProxyAddresses = objRecordSet.Fields("proxyAddresses")
If IsArray(objRecordSet.Fields("proxyAddresses")) Then
strResult = strResult & VbCrLf & "Proxy Addresses"
For Each ProxyAddress in arrProxyAddresses
'Sub: Check X400
If InStr(ProxyAddress, strX400Search) <> 0 Then
'Wscript.Echo "#This was an x400"
Else
strResult = strResult & VbCrlf & proxyAddress
End If 'Ends loop for X400 address
Next
Else
strResult = strResult & VbCrlf & "#Object does not have proxy addresses"
End If
strResult = strResult & VbCrLf
Else
strErrorResult = strErrorResult & "Contact ERROR: " & strUserDN & vbCrLF
End If
On Error GoTo 0
objRecordSet.MoveNext
Wend
'******************************************************
'Execute search command to look for Groups
objCommand.CommandText = _
"<" & strADPath & ">" & ";(&(objectClass=group)(mail=*))" & ";distinguishedName,displayName,mail,proxyAddresses;subtree"
'Execute search to get Recordset
Set objRecordSet = objCommand.Execute
strResult = strResult & vbCrlf & "################################################################Groups"
strResult = strResult & VbCrlf & "#Total Mail Enabled Groups Found: " & objRecordSet.RecordCount & VbCrlf
AddressCount = 0
While Not objRecordSet.EOF 'Iterate through the search results
strUserDN = objRecordSet.Fields("distinguishedName") 'Get User's distinguished name from Recordset into a string
On Error Resume Next
set objUser= GetObject("LDAP://"& Replace(strUserDN, "/", "\/") & "") 'Use string to bind to user object
If err.Number = 0 Then
strResult = strResult & VbCrlf & "cn: " & objUser.cn
strResult = strResult & VbCrlf & "mail: " & objUser.mail
arrProxyAddresses = objRecordSet.Fields("proxyAddresses")
If IsArray(objRecordSet.Fields("proxyAddresses")) Then
strResult = strResult & VbCrLf & "Proxy Addresses"
For Each ProxyAddress in arrProxyAddresses
'Sub: Check X400
If InStr(ProxyAddress, strX400Search) <> 0 Then
'Wscript.Echo "#This was an x400"
Else
strResult = strResult & VbCrlf & proxyAddress
End If 'Ends loop for X400 address
Next
Else
strResult = strResult & VbCrlf & "#Object does not have proxy addresses"
End If
strResult = strResult & VbCrLf
Else
strErrorResult = strErrorResult & "Group ERROR: " & strUserDN & vbCrLF
End If
On Error GoTo 0
objRecordSet.MoveNext
Wend
'******************************************************
'Execute search command to look for Public Folders
objCommand.CommandText = _
"<" & strADPath & ">" & ";(&(objectClass=publicfolder)(mail=*))" & ";distinguishedName,displayName,mail,proxyAddresses;subtree"
'Execute search to get Recordset
Set objRecordSet = objCommand.Execute
strResult = strResult & vbCrlf & "#########################################################Public Folders"
strResult = strResult & VbCrlf & "#Total Mail Enabled Public Folders Found (Includes System Folders!): " & objRecordSet.RecordCount & VbCrlf
AddressCount = 0
While Not objRecordSet.EOF 'Iterate through the search results
strUserDN = objRecordSet.Fields("distinguishedName") 'Get User's distinguished name from Recordset into a string
On Error Resume Next
set objUser= GetObject("LDAP://"& Replace(strUserDN, "/", "\/") & "") 'Use string to bind to user object
If err.Number = 0 Then
strResult = strResult & VbCrlf & "cn: " & objUser.cn
strResult = strResult & VbCrlf & "mail: " & objUser.mail
arrProxyAddresses = objRecordSet.Fields("proxyAddresses")
If IsArray(objRecordSet.Fields("proxyAddresses")) Then
strResult = strResult & VbCrLf & "Proxy Addresses"
For Each ProxyAddress in arrProxyAddresses
'Sub: Check X400
If InStr(ProxyAddress, strX400Search) <> 0 Then
'Wscript.Echo "#This was an x400"
Else
strResult = strResult & VbCrlf & proxyAddress
AddressCount = AddressCount + 1
End If 'Ends loop for X400 address
Next
Else
strResult = strResult & VbCrLf & "#Object does not have proxy addresses"
End If
strResult = strResult & VbCrLf
Else
strErrorResult = strErrorResult & "Public Folder ERROR: " & strUserDN & vbCrLF
End If
On Error GoTo 0
objRecordSet.MoveNext
Wend
'*************************************
'Execute search command to look for Users
varDisabledCounter = 0
'Execute search command to look for user
objCommand.CommandText = _
"<" & strADPath & ">" & ";(&(objectClass=user)(mail=*))" & ";distinguishedName,displayName,mail,proxyAddresses;subtree"
'Execute search to get Recordset
Set objRecordSet = objCommand.Execute
strResult = strResult & vbCrlf & "#################################################################Users"
strResult = strResult & VbCrlf & "#Total Mail Enabled Users Found: " & objRecordSet.RecordCount & VbCrlf
AddressCount = 0
While Not objRecordSet.EOF 'Iterate through the search results
strUserDN = objRecordSet.Fields("distinguishedName") 'Get User's distinguished name from Recordset into a string
On Error Resume Next
set objUser= GetObject("LDAP://"& Replace(strUserDN, "/", "\/") & "") 'Use string to bind to user object
If err.Number = 0 Then
If objUser.AccountDisabled = TRUE Then 'If User account disabled, then skip proxy address enum
varDisabledCounter = varDisabledCounter + 1
strResult2 = strResult2 & VbCrLf & varDisabledCounter & " " & objUser.displayName & VbCrLf
strResult2 = strResult2 & "cn: " & objUser.cn
strResult2 = strResult2 & VbCrlf & "mail: " & objUser.mail
arrProxyAddresses = objRecordSet.Fields("proxyAddresses")
If IsArray(objRecordSet.Fields("proxyAddresses")) Then
strResult2 = strResult2 & VbCrLf & "Proxy Addresses"
For Each ProxyAddress in arrProxyAddresses
'Sub: Check X400
If InStr(ProxyAddress, strX400Search) <> 0 Then
'Wscript.Echo "#This was an x400"
Else
strResult2 = strResult2 & VbCrlf & proxyAddress
AddressCount = AddressCount + 1
End If 'Ends loop for X400 address
Next
Else
strResult2 = strResult2 & VbCrLf & "#Object does not have proxy addresses"
End If
strResult2 = strResult2 & VbCrLf
Else
strResult = strResult & VbCrlf & "cn: " & objUser.cn
strResult = strResult & VbCrlf & "mail: " & objUser.mail
arrProxyAddresses = objRecordSet.Fields("proxyAddresses")
If IsArray(objRecordSet.Fields("proxyAddresses")) Then
strResult = strResult & VbCrLf & "Proxy Addresses"
For Each ProxyAddress in arrProxyAddresses
'Sub: Check X400
If InStr(ProxyAddress, strX400Search) <> 0 Then
'Wscript.Echo "#This was an x400"
Else
strResult = strResult & VbCrlf & proxyAddress
AddressCount = AddressCount + 1
End If 'Ends loop for X400 address
Next
Else
strResult = strResult & VbCrLf & "#Object does not have proxy addresses"
End If
strResult = strResult & VbCrLf
End If 'End check for disabled user
Else
strErrorResult = strErrorResult & "User ERROR: " & strUserDN & vbCrLF
End If
On Error GoTo 0
objRecordSet.MoveNext
Wend
strResult = "SMTP Email Addresses for Contacts, Groups, Public Folders, & Users" & VbCrLf & "----------------------------------------------------------------------" & VbCrLf & strResult
strResult = strResult & VbCrLf & "########################################################Disabled Users" & VbCrLf & strResult2
If Len(strErrorResult) > 0 Then
' WScript.Echo strErrorResult
strResult = strResult & vbCrLF & vbCrLF & "################################################################ERRORS" & vbCrLF
strResult = strResult & "#The following object(s) had errors and could not be read:" & vbCrLF
strResult = strResult & strErrorResult
End If
'Output to a text file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFileSystem.CreateTextFile("C:\EmailAddresses.txt")
objOutputFile.Write strResult