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