Active Directory create Contact

Hier gibt es den zentralen Source Code zu der Prozedur Kontakte anlegen. Wie immer aus einer Textdatei mit den gültigen Domain Daten.

'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 (administrativer Art). Ich übernehme keinerlei Gewährleistung für evtl. auftretende Schäden. Sie benutzen das Tool auf eigene Gefahr. Bitte sichern Sie zuvor Ihre Daten! Ich übernehme keine Gewähr!