' alle legacyExchangeDN der GAL-Kontakte so ändern,
  ' dass Eintrag vorhanden ist und gefüllt wird
  ' SELECT samaccountname,name,mail,legacyExchangeDN FROM 'LDAP://DC=my,DC=dom,DC=ain' WHERE objectclass = 'contact' AND NOT legacyExchangeDN = '*' 

 Dim oUser,email, memberOf , buf , DisName , legacyExchangeDN, name , distinguishedName, Field
 DIM arrlegacyExchangeDN(),arrEmail(),arrName(),arrdistinguishedName()
 i = 0
 j = 0

 Field = "legacyExchangeDN"
 
 i = Abfrage(Field) 
 
  for j = 0 to i - 1
     'hier eigene administrative Gruppe eintragen:
      ChangeField arrdistinguishedName(j),Field,"/o=MyDomain/ou=Erste administrative Gruppe/cn=Recipients/cn=" & arrEmail(j)
      j = j + 1
  next
  
' -------------------------------------------------------------------------
' Benutzerattribute gezielt mit ADO per SQL suchen
' -------------------------------------------------------------------------
Function Abfrage(Field)

Dim objDSE, objConnection, objCommand, objRecordset, i , objDNC , cT , rstU


Set objDSE = GetObject("LDAP://rootDSE")
objDNC = objDSE.Get("defaultNamingContext")
Set objDSE = Nothing
'hier den eigenen FQDN eintragen:
cT = "SELECT " & Field & ",mail,name,distinguishedName FROM 'LDAP://DC=my,DC=dom,DC=ain' WHERE objectclass = 'contact' AND NOT legacyExchangeDN = '*' "

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open

Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection

objCommand.CommandText = cT
Set objRecordset = objCommand.Execute


If Not objRecordset.EOF Then
   While Not objRecordset.EOF
	on error resume next
	email =  objRecordset.Fields("mail")
        ReDim Preserve arrEmail(i)
        arrEmail(i) = email 
	name =  objRecordset.Fields("name")
	ReDim Preserve arrName(i)
        arrName(i) = name
	legacyExchangeDN = objRecordset.Fields("legacyExchangeDN")
	ReDim Preserve arrlegacyExchangeDN(i)
        arrlegacyExchangeDN(i) = legacyExchangeDN
        distinguishedName = objRecordset.Fields("distinguishedName")
        ReDim Preserve arrdistinguishedName(i)
        arrdistinguishedName(i) = distinguishedName
        i = i + 1
     objRecordset.MoveNext
   Wend
 End if
 objRecordset.Close
 objConnection.Close
 Abfrage = i
End Function

'-------------------------------------------------------------------------
'legacyExchangeDN ändern 
'-------------------------------------------------------------------------
sub ChangeField(DisName,Field,Target)

Set oTargetOU = GetObject("LDAP://" & DisName)
 
oTargetOU.Put Field, Target
wscript.echo j & DisName & vbTab & Target
oTargetOU.SetInfo
set oTargetOU = Nothing

End Sub

' -------------------------------------------------------------------------