AD-Attribut legacyExchangeDN nachträglich ändern

Durch einen Bug wird bei Übernahme von Kontakten einer anderen Exchangeorganisation kein AD-Attribut „legacyExchangeDN“ angelegt.
Dadurch kann man zwar den Kontakt in Outlook sehen aber keine Mails an den Kontakt schicken.
Dies Script trägt nachträglich die Einstellungen nach und benutzt dafür die Mailadresse, die ja einmalig ist (im Gegensatz zum Anzeigenamen):
Sie benötigen zur Ausführung die eigene „administrative Gruppe“ und den „FQDN“ des AD.(s.u.)

changelegacyExchangeDN.vbs
  ' 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
 
' -------------------------------------------------------------------------


siehe auch: LegacyExchangeDN per dsa.msc bearbeiten