'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

