textdatei= "c:\skripte\ipsen.txt"
set objRoot = GetObject("LDAP://rootDSE")
ldap = "LDAP://"&objRoot.Get("DefaultNamingContext")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile(textdatei, True)
On Error Resume Next

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

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

Command= "SELECT distinguishedname,Name,mail,proxyAddresses FROM '"&ldap&"'" 
objCommand.CommandText = Command
     
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
    objTextFile.WriteLine "--"
      objTextFile.WriteLine objRecordSet.Fields("name").Value  
      objTextFile.WriteLine objRecordSet.Fields("distinguishedname").Value 
if objRecordSet.Fields("mail") <> "" then 
For each email in objRecordSet.Fields("proxyAddresses").Value
       If Left (email,4) = "SMTP" or Left (email,4) = "smtp" then 
         objTextFile.WriteLine mid(email,6)
       end if
Next
   
    objTextFile.WriteLine "-"
end if
    objRecordSet.MoveNext
Loop

objTextFile.Close