WhiteBerry

Active Directory create User

Details

Zuletzt aktualisiert am Donnerstag, 25. Oktober 2007 16:59

Active Directory create User

zentraler Source Code zu der Prozedur User anlegen

'User anlegen in der root der Domain
Private Sub mnu_User_Create_Click()
Dim objAs, sUser, sOU, sGroup
Dim Container As IADsContainer
Dim user As IADsUser
Dim objUser

'Variablen belegen
sLastName = cNachname.Text
sGivenName = cVorname.Text
sFullname = sLastName & " " & sGivenName
sDescription = "User"
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("User", "CN=" & sFullname)
  objUser.FullName = sFullname
  objUser.Description = sDescription
  objUser.LastName = sLastName
  objUser.GivenName = sGivenName
  objUser.Put "company", "Company"
  
  objUser.Put "samAccountname", LCase(cAccountname)
  objUser.Put "UserPrincipalName",_
  LCase(cAccountname) & "@" & Domain
  objUser.SetInfo

  Kontrollfeld.Text = Err.Number & " ; " & Err.Description
  Err.Clear
  
  Set user = adsi.OpenDSObject("LDAP://" &_
  Domain & "/" & "CN=" & sFullname & "," &_
  DomSTR2, admin.Text, adminpwd.Text, 1)
  Set Container = GetObject(user.Parent)
  user.AccountDisabled = False
  user.SetPassword (cpassword.Text)
  user.SetInfo
  If Err.Number = 0 Then cerror =_
  "User erfolgreich angelegt" Else cerror =_
  Err.Number & " ; " & Err.Description
  Kontrollfeld.Text = cerror
  Err.Clear
End Sub

Die Ausführung bestimmter Tools erfordert spezielle Rechte (Administrativer Art). Ich übernehme keinerlei Gewähleistung für evtl. auftretende Schäden. Sie benutzen das Tool auf eigene Gefahr. Bitte sichern Sie zuvor Ihre Daten! Ich übernehme keine Gewähr !!! Falls Fragen sein sollten. Bitte sendet mir eine Mail. Diese E-Mail-Adresse ist vor Spambots geschützt! Zur Anzeige muss JavaScript eingeschaltet sein!