Create a contact in Active Directory

Hier gibt es den Source Code um in einer Active Directory Struktur Kontakte anzulegen.

Was wird dafür benötigt?

Ihr müsst über die nötigen Rechte verfügen. Ihr braucht ein Rohdaten, wie immer aus einer Textdatei mit den gültigen Daten. Die Eingangsdatei prüfe ich nicht auf Fehler. Das muss vorab erfolgen, oder ihr programmiert diese Funktion aus und setzt diese dann vor die eigentliche Importfunktion.

'Contact anlegen in der root der Domain
Dim objAs, sUser, sOU, sGroup
Dim Container As IADsContainer
Dim objUser

'Variablen belegen
sLastName = cNachname.Text
sGivenName = cVorname.Text
sFullname = sLastName & " " & sGivenName
sDescription = "Contact"

Set adsi = GetObject("LDAP:")
  
Dim dc(10)
tmp = Domain.Text
i = 1
While (InStr(1, tmp, ".")) <> 0
laenge = Len(tmp)
punkt = InStr(1, tmp, ".")
dc(i) = Left(tmp, punkt - 1) & ","
rest = laenge - punkt
tmp = Right(tmp, rest)
i = i + 1
Wend
dc(i) = tmp
For K = 1 To i
  DomSTR2 = DomSTR2 & "dc=" & dc(K)
Next K
DomSTR = Domain.Text & "/" & DomSTR2
  Set objAs = adsi.OpenDSObject("LDAP://" &_
  DomSTR, admin.Text, adminpwd.Text, 1)
  Set objUser = objAs.Create("Contact", "CN=" & sFullname)
  objUser.FullName = sFullname
  objUser.Description = sDescription
  objUser.LastName = sLastName
  objUser.GivenName = sGivenName
  objUser.Put "company", "Company"
  objUser.SetInfo
  Kontrollfeld.Text = Err.Number & " ; " & Err.Description
  Err.Clear
End Sub

Die Ausführung bestimmter Tools erfordert spezielle Rechte (Schreibrechte in der entsprechenden OU). Ich übernehme keinerlei Gewährleistung für evtl. auftretende Schäden. Sie benutzen das Tool auf eigene Gefahr. Bitte sichert zuvor eure Daten! Ich übernehme keine Gewährleistung.

Michael Leidig