'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