Kategorien
Scripte

Active Directory create User

Binäre Darstellung

Active Directory create User

Hier ist der zentrale Source Code zu der Prozedur User anlegen.
Anpassen müsst ihr nur Domain, und natürlich eine Userliste bereitstellen.

'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

Von Michael

wohnhaft in München
arbeite bei der Landeshauptstadt München

Schreiben Sie einen Kommentar

Ihre E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert