'#################################
'#                               #
'# Organisationseinheit anlegen  #
'#                               #
'#################################
 
'# Auf diesem Server werden die neue OUs anlegen
ldap = "LDAP://DC1W2K"
 
Set domainDNS = GetObject(ldap)
 
'# geben Sie die OU ein die angelgegt werden soll
name = InputBox("Bitte geben Sie den Namen der Organisationseinheit an, die" & _
  "angelegt werden soll!")
 
'# Es wird geprüft, ob die Anzulegende bereits besteht
If name="" then
 
	query = "objectCategory='organizationalUnit'"
else
	query = "objectClass='organizationalUnit' and name='" & name & "'"
    	On Error Resume Next
	MsgBox "Die von Ihnen gewünschte OU ist bereits vorhanden. Bitte wählen Sie" & _
  "eine andere."
	'mit OU verbinden, die gelöscht werden soll
	'hier OU löschen
	ldap = "LDAP://DC1W2K"
 
	'mit Domäne verbinden
	'Set domainDNS = GetObject(ldap)
	Set domainDNS = GetObject("LDAP://dc1w2k/DC=projekt,DC=local")
 
	'mit OU verbinden, die gelöscht werden soll
	Set ou = domainDNS.GetObject("organizationalUnit", "ou=" & name)
 
	'Rekursiv OU löschen
	DeleteOU ou.ADsPath
	MsgBox "OU gelöscht."
 
	Sub DeleteOU(ADsPath)
		Set ou = GetObject(ADsPath)
		ou.Filter = Array("organizationalUnit")
		For each subou in ou
			DeleteOU subou.ADsPath
		Next
 
		ou.Filter = Array()
		For each obj in ou
			ou.delete obj.class, obj.name
		Next
		Set container = Getobject(ou.parent)
		container.Delete "organizationalUnit", ou.name
	End Sub
	On Error Goto 0
End If
 
 
fehler:
'# top-level-OU anlegen
Set ou = domainDNS.Create("organizationalUnit", "ou=" & name)
ou.SetInfo
 
On Error Goto fehler 'bei diesem Aufruf wird ein Syntaxfehler ausgegeben. Ich 
' kann ihn mir nur nicht erklären.
 
'#####################################
'#                                   #
'# Nun werden die Benutzer angelegt  #
'#                                   #
'#####################################
 
'# Die Benutzer aus der Textdatei Klassenliste.txt wird geöffnet und ausgelesen
Dim fso, f, Zeile, Feld
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile ("Klassenliste.txt",1,0)
 
Do while not f.AtEndOfLine
Zeile = f.readLine
Feld = split(Zeile,",")
 
'# Das Feld 0 wird mit mit dem Benutzernamen aus der Textdatei gefüllt
Benutzer = Feld(0)
 
'# Das Feld 1 wird mit dem Vornamen aus der Textdatei gefüllt
Vorname = Feld(1)
 
'# Das Feld 2 wird mit dem Nachnamen aus der Textdatei gefüllt
Nachname = Feld(2)
 
'# Das Feld 3 wird mit dem Passwort aus der Textdatei gefüllt
Passwort = Feld(3)
 
Call BenuntzerAnlegen(Benutzer,Vorname,Nachname,Passwort)
Loop
f.Close
Wscript.Quit(0)
 
Sub BenuntzerAnlegen(Benutzer,Vorname,Nachname,Passwort)
Dim ouo, user
Set ouo = GetObject("LDAP://DC1W2K/OU=" & name & ",DC=projekt,DC=local")
Set user = ouo.Create("user", "CN=" & Vorname & " " & Nachname)
Dim WshShell, ret
Set WshShell = WScript.CreateObject("WScript.Shell")
 
'# Hier werden die Eigenschaften in der in der Allgemeinkartei eingerichtet ( 
' Name, Vorname, etc.)
user.Put "sAMAccountName", Benutzer
user.Put "displayName", Vorname & " " & Nachname
user.Put "givenName", Vorname
user.Put "sn", Nachname
 
'# Das Häkchen soll bei "Kennwort muss beim nächsten Anmelden erneuert werden" 
' setzen
'#user.Put "pwdLastSet", 0
 
'# Hier wird der Benutzeranmeldename mit Domäne eingerichtet
user.Put "userPrincipalName", Benutzer & "@projekt.local"
 
'# Dem Benutzer wird ein extra für den Benutzer zugehörigen Profilpfad 
' zugewiesen
user.Put "profilePath", "\\dc1w2k\profile2$\" & Benutzer
 
'# Skript legt eigenständig das Heimatverzeichnis des Benutzers und verbindet 
' dieses automatisch mit H: auf dem Server
user.Put "homeDirectory", "\\dc1w2k\home$\" & Benutzer
user.Put "homeDrive", "H:"
 
'# Die Einstellungen für den Benutzer werden durch SetInfo übernommen
user.SetInfo
user.SetPassword Passwort
 
'# Das Benutzerkonto wird mit dem nachfolgenden Befehl aktiviert
user.AccountDisabled = False
user.SetInfo
 
'# Das Script wird mit einer kleinen Zeitverzögerung wiederholt
WScript.Sleep(500)
ret = WshShell.Run ("verz.cmd " & Benutzer,0,1)
End Sub