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.)
' 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