wladislaw
Jul 09, 2012
view8420
view37
0
Goto Top

VBScript für automatische User Erstellung im AD

GermansolvedQuestionVB for ApplicationsDevelopment

Hallo Zusammen,

ich brauche eure Hilfe in VBscript Programmierung.Ich bedanke mich im Voraus.

ich muss mehrere users aus einer User.TXT Datei im AD erstellen.

-----------------User.TXT----------
Nchname,Vorname,Passwort,PersNr

Müller,Markus,pwd1@qwe,1234
Mayer,Sven,pwd2@qwe,5678
Halder,Martin,pwd3@qwe,9876

Ich habe eizelne Scripts aus dem Internet (ein großen Dank an die Scripts Ersteller) auf meine Wünsche teilweise angepasst, leider fehlen mir einzelne Optionen in User.VBS:

- Benutzername in "sAMAccountName"

der Benutzername hat folgenden Syntaxsis: erste 6 Buchstaben Nachname + erste Buchstabe Vorname (aus User.txt).
1.Beim neuen Account muss geprüft werden, dass keine doppelten Usernamen im AD existieren, ansonsten muss ich alarmiert werden (oder Log Datei).
2. Alle Umlaute sollten in NICHT Umlaute konvertiert werden (z.B. ü in ue, ä in ae)

- Homedirsrv in "homeDirectory"

wir haben 4 Homedirectory Server Homedirsrv01 bis Homedirsrv05. Alle User sind über eine Buchstaben Regelung gesplittet: erste Buchstabe des Benutzername

Homedirsrv01 (a-e)
Homedirsrv02 (f-j)
Homedirsrv03 (k-r)
Homedirsrv04 (s-z)


user.vbs------------------------

Dim fso, f, Zeile, Feld
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile ("user.txt",1,0)


Do while not f.AtEndOfLine
Zeile = f.readLine
Feld = split(Zeile,",")
Nachname = Feld(0)
Vorname = Feld(1)
Passwort = Feld(2)
PersNr = Feld(3)
Call BenuntzerAnlegen(Vorname,Nachname,Passwort,PersNr)
Loop
f.Close
Wscript.Quit(0)

Sub BenuntzerAnlegen(Vorname,Nachname,Passwort,PersNr)
Dim ouo, b
Set ouo = GetObject("LDAP://OU=Test,DC=AD,DC=DOMAIN,DC=DE")
Set b = ouo.Create("user", "CN=" & Benutzer)
Dim WshShell, ret
Set WshShell = WScript.CreateObject("WScript.Shell")
b.Put "sAMAccountName", Benutzername??????
b.Put "profilePath", "\\Server1\Profiles$\" & Benutzer
b.Put "scriptPath", "login.bat"
b.Put "homeDirectory", "\\Homedirsrv?????\Homedirectory$\" & Benutzer
b.Put "homeDrive", "P:"
b.Put "employeeID", PersNr
b.Put "displayName", Nachname & " " & Vorname
b.SetInfo
b.SetPassword Passwort
b.AccountDisabled = False
b.SetInfo
WScript.Sleep(1000)
ret = WshShell.Run ("verz.cmd " & Benutzername?????,0,1)
End Sub

- ob es eine Möglichkeit gibt den Inhalt von Verz.CMD Datei in User. vbs Script zu integrieren

Homedirsrv aus user.vbs = Fileserver aus verz.cmd

verz.cmd------------------

echo off

set User=%1
set Name=%User:~0,1%


echo Name=%Name%


for %%a in (a b c d e) do if /i %Name%==%%a goto FS1
for %%a in (f g h i j) do if /i %Name%==%%a goto FS2
for %%a in (k l m n o p q r) do if /i %Name%==%%a goto FS3
for %%a in (s t u v w x y z) do if /i %Name%==%%a goto FS4

:FS1
set Fileserver=Homedirsrv01
goto start

:FS2
set Fileserver=Homedirsrv02
goto start

:FS3
set Fileserver=Homedirsrv03
goto start

:FS4
set Fileserver=Homedirsrv04
goto start

:start
md \\%Fileserver%\HomeDirectory\%1
cacls \\%Fileserver%\HomeDirectory\%1 /t /e /c /g Domain\Domänen-Admins:F
cacls \\%Fileserver%\HomeDirectory\%1 /t /e /c /g Domain\%1:c


md \\Server02\profiles\%1
cacls \\Server02\profiles\%1 /t /e /c /g Domain\Domänen-Admins:F
cacls \\Server02\profiles\%1 /t /e /c /g Domain\%1:c
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 187696

Url: https://administrator.de/contentid/187696

Printed on: April 19, 2024 at 01:04 o'clock

37 Comments
Latest comment
Goto Top
Mitglied: 76109
76109 Jul 09, 2012 updated at 17:39:48 (UTC)
Goto Top
Hallo wladislaw!

Eventuell könnte man das Ganze in's VB-Script mit einbauen:
    Dim arrCmdLines, strCmdLine, strUserName, strFileServer, i

    strUserName = InputBox("Bitte Username eingeben:", "Username...")  
    
    Select Case LCase(Left(strUserName, 1))
        Case ""  
            MsgBox "Abbruch oder Leereingabe!", vbInformation, "Hinweis...":   WScript.Quit 1  
        Case "a", "b", "c", "d", "e"  
            strFileServer = "Homedirsrv01"  
        Case "f", "g", "h", "i", "j"  
            strFileServer = "Homedirsrv02"  
        Case "k", "l", "m", "n", "o", "p", "q", "r"  
            strFileServer = "Homedirsrv03"  
        Case Else
            strFileServer = "Homedirsrv04"  
    End Select

    arrCmdLines = Array("md ""\\%1\HomeDirectory\%2""", _  
                       "cacls ""\\%1\HomeDirectory\%2"" /t /e /c /g ""Domain\Domänen-Admins"":F", _  
                       "cacls ""\\%1\HomeDirectory\%2"" /t /e /c /g ""Domain\%2"":c", _  
                       "md ""\\Server02\profiles\%2""", _  
                       "cacls ""\\Server02\profiles\%2"" /t /e /c /g ""Domain\Domänen-Admins"":F", _  
                       "cacls ""\\Server02\profiles\%2"" /t /e /c /g ""Domain\%2"":c")  
    

    For i = 0 To UBound(arrCmdLines)
        arrCmdLines(i) = Replace(Replace(arrCmdLines(i), "%1", strFileServer), "%2", strUserName)  
    Next

    
    With CreateObject("WScript.Shell")  
        For Each strCmdLine In arrCmdLines
             MsgBox strCmdLine                  'Test: Ausgabe der CmdLines  
           '.Run strCmdLine,0,True  
        Next
    End With

Und siehe Dir mal die Formatierungshilfe an. Stichwort: Code-Tagsface-wink

Gruß Dieter
Member: wladislaw
wladislaw Jul 10, 2012 at 12:23:55 (UTC)
Goto Top
Hallo Dieter,

Danke für deine Hilfe!!!
Könntest du mir bitte sagen wie könnte ich eine Schleife für mehrere Users aus USER.TXT in Bezug auf deinen Sckript erstellen. Danke.

Gruß Wladislaw
Mitglied: 76109
76109 Jul 10, 2012 at 14:57:55 (UTC)
Goto Top
Hallo Wladislaw!

Kein Problemface-wink

Und wie ist die Textdatei aufbebaut? Pro Zeile ein User oder wie?

Gruß Dieter
Member: wladislaw
wladislaw Jul 11, 2012 at 06:30:35 (UTC)
Goto Top
Hallo Dieter,
ich habe eine Excel Tabelle mit Spalten (Nachname,Vorname,Passwort,PersNr)und kann diese Tabelle als TXT abspeichern.

User.TXT----------

Mustermann Simon password@1 47444
Müller Irina password@2 42833
Mayer Iris password@3 43421
Miller Katja password@4 43522

Gruß Wladislaw
Mitglied: 76109
76109 Jul 11, 2012 at 08:54:12 (UTC)
Goto Top
Hallo wladislaw!

Das kann man auch direkt aus Excel einlesen.

Hat die Exceldatei ein/mehrere Tabellenblätter und fangen die Einträge (UserName) in Spalte A/Zeile2 an und enden ohne Leerzeilen?

Benötigst Du Nach- und Vorname und/oder befinden sich Nachname/Vorname in getrennten Spalten?

Gruß Dieter
Member: wladislaw
wladislaw Jul 11, 2012 at 12:32:29 (UTC)
Goto Top
Hallo Dieter,

Excleldatei hat nur einen Tabelenblat und die Einträge fangen in Spalte A/2 und enden ohne leerzeilen. Ich habe 4 getrente Spalte: Nachname Vorname Passwort PersNr

Gruß Wladislaw
Mitglied: 76109
76109 Jul 11, 2012 updated at 17:19:14 (UTC)
Goto Top
Hallo Wladislaw!

Eigentlich könnte man ja in die Excelliste auch gleich die Benutzernamen in der nächsten freien Spalte eintragen.

U.a. nehme ich mal an, dass der Benutzername bei kürzeren Nachnamen, dann mit dem Vornamen auf 7 Buchstaben aufgerundet werden soll?

Und falls der Benutzername schon existiert, dann vom Vornamen den 2., 3., ... Buchstaben nehmen?

Gruß Dieter
Member: wladislaw
wladislaw Jul 12, 2012 at 08:44:31 (UTC)
Goto Top
Hallo Dieter,

ja, man kann im Excell eine neu Spalte z.B. Benutzername erstellen (=VERKETTEN(LINKS(C1;6);LINKS(D1;1))). Kann man prüfen, dass ein Benutzername in Active Directory bereits existirt? Und ob es möglich wäre, sobald ein Benutzername in Active Directory existiert, sollte ich per MessageBox oder per Log informiert werden. Der Script muss diesen User überspringen und weiterlaufen.
Der Benutzername bei kürzeren Nachnamen sollte nicht auf 7 Buchstaben aufgerundet werden.

Gruß Wladislaw
Mitglied: 76109
76109 Jul 12, 2012 updated at 09:45:47 (UTC)
Goto Top
Hallo Wladislaw!

Du hast mich leider völlig missverstandenface-wink

ja, man kann im Excell eine neu Spalte z.B. Benutzername erstellen (=VERKETTEN(LINKS(C1;6);LINKS(D1;1))).
Das Einfügen der Benutzernamen in eine Excelspalte war eigentlich so gedacht, dass er vom Skript aus eingefügt werden kann/sollte.

Ablauf im Skript:
Spalten (1-5) einlesen
Prüfen ob die Spalte Benutzername Leer/Belegt ist
Wenn Belegt, dann Benutzername übernehmen (bleibt unverändert)
Wenn Leer, dann Benutzername - sofern noch nicht vorhanden - erzeugen und in die Leere Zelle eintragen

Der Benutzername bei kürzeren Nachnamen sollte nicht auf 7 Buchstaben aufgerundet werden.
D.h. das z.B. 'Dorn Peter' in 'DornP' umgewandelt werden soll?

Inzwischen habe ich schonmal eine Routine geschrieben, die zum einen die Umlaute entsprechend umwandelt und zum anderen, wenn bereits vorhanden, folgende Anpassungen vornehmen könnte:

Beispiel mit den Namen "Dorn Peter, Müller Anton, Müller Andrea, Müller Anton" ('Müller Anton' doppelt), dann wäre das Ergebnis:
DornPet
MuelleA
MuellAn
MuelAnt

Ist natürlich wesentlich einfacher nur ne Fehlermeldung auszugebenface-wink Die Frage, die sich mir dabei stellt, was dann?

Kann man prüfen, dass ein Benutzername in Active Directory bereits existirt...
Da muss ich - zumindest im Moment - leider passen, da ich keinerlei Erfahrung mit AD's habe. Aber Möglicherweise kann man ja einfach prüfen, ob schon ein Verzeichnis mit dem Benutzernamen existiert? Andererseits wären dann andere Experten auf diesem Gebiet gefragtface-wink

Gruß Dieter
Member: wladislaw
wladislaw Jul 12, 2012 at 13:07:49 (UTC)
Goto Top
Halo Dieter,

ja, ich habe dicht missverstanden.

Könntest du bitte in deine Routine (wenn noch möglich ist face-wink)bei bereits vorhendenem User folgende Anpassungen vornehmen:

Beispiel mit den Namen "Dorn Peter, Müller Anton, Müller Andrea, Müller Anton" ('Müller Anton' doppelt), dann wäre das Ergebnis:
DornPet
MuelleA
Muell1A
Muell2A

Bezuglich "Vergleich im AD´s" frage ich bei anderen Experten.

Gruß Wladislaw
Mitglied: 76109
76109 Jul 15, 2012, updated at Jul 25, 2012 at 20:33:41 (UTC)
Goto Top
Hallo Wladislaw!

Habe hier mal so'n groben Entwurf zusammengebastelt. Allerdings habe ich keine Möglichkeit zu testen, ob der Zugriff auf die ADS-Daten und das hinzufügen eines neuen User's funktioniert. Hier besteht möglicherweise noch Handlungsbedarf?

Der besseren Übersicht wegen, habe ich alle Funktionen in seperate Code-Tags gepackt (Der Reihenfolge nach in eine *.vbs-Datei kopieren).

Im Groben verläuft der Ablauf in etwa so:
- Eine Verbindung mit dem ADS herstellen und User-Daten einlesen.
- Excel-Daten einlesen und neue User-Daten in ein Array schreiben.
- Excel-Daten mit Benutzernamen (Spalte 5) mit ADS abgleichen.
- Neue User im ADS anlegen
- Log-Daten (User: ..., Fehler) sammeln und am Ende in die Log-Datei schreiben.

Option Explicit

Private Const ExcelFile = "E:\Test\User.xls"   '###Pfad anpassen  
Private Const ExcelStart = 2                   'Zeile mit dem 1. Eintrag  

Private Const LogFile = "E:\Test\User.Log"     '###Pfad anpassen  

Private Const AccountLength = 7                'Anzahl Zeichen Benutzername  

Private Const xlUp = &HFFFFEFBE                'Konstante: Excel  
Private Const ADS_SCOPE_SUBTREE = 2            'Konstante: ADO-Recordset  

Private Const MsgErr1 = "Datenimport vom ADS fehlgeschlagen!"  
Private Const MsgErr2 = "Datemimport aus Excel-Datei fehlgeschlagen!"  

Private Const LogErr1 = "Benutzername erstellen"  
Private Const LogErr2 = "User dem ADS hinzufügen"  
Private Const LogErr3 = "HomeDir/Profile-Verzeichnis erstellen"  
Private Const LogErr4 = "HomeDir/Profile-Berechtigungen erstellen"  


Private oUserCon, oUserRec, oUserList, oUser, aDaten, sLogMsg, iCountADS1, iCountADS2, iCountExcel


'Main Beg  

    'ADS-Daten einlesen  
    If OpenUserRec = False Then
        MsgBox MsgErr1, vbExclamation, "Fehler...":  WScript.Quit  
    End If
    
    'Assoziatives Array für neue User-Daten  
    Set oUserList = CreateObject("Scripting.Dictionary")  
    
    'Excel-Daten einlesen und neue User im ADS anlegen  
    If GetUserDaten = False Then
        MsgBox MsgErr2, vbExclamation, "Fehler...":  
    Else
        For Each oUser In oUserList.Items
            aDaten = Split(oUser, ";")  
            Call CreateNewUser(aDaten(0), aDaten(1), aDaten(2), aDaten(3), aDaten(4))
        Next                  'Nachname   Vorname    Passwort   Pers-Nr.   Benutzer  
    End If
    
    If oUserCon.State Then oUserCon.Close
    
    Call WriteLogFile(LogFile)

    MsgBox "Fertig!", vbInformation, "Hinweis...":  

'Main End  
'Diese Function Liest die User-Daten aus dem ADS in einen Recordset (ungetestet)  

Private Function OpenUserRec()
    Dim oUserCom
    
    On Error Resume Next
    
    Set oUserCon = CreateObject("ADODB.Connection")  
    Set oUserCom = CreateObject("ADODB.Command")  
    
    oUserCon.Provider = "ADsDSOObject"  
    oUserCon.Open "Active Directory Provider"  
    
    Set oUserCom.ActiveConnection = oUserCon
    
    oUserCom.Properties("Page Size") = 1000  
    oUserCom.Properties("Searchscope") = ADS_SCOPE_SUBTREE  
    
    '#########Entsprechend anpassen  
    oUserCom.CommandText = "SELECT * FROM 'LDAP://DC=Test,DC=DOMAIN,DC=DE' WHERE ObjectCategory='user'"  
        
    Set oUserRec = oUserCom.Execute
    
    If Err Then
        OpenUserRec = False        
        If oUserCon.State Then oUserCon.Close
    Else
        OpenUserRec = True
        iCountADS1 = oUserRec.RecordCount:  iCountADS2 = iCountADS1 
    End If
End Function
'Diese Funktion liest die User-Excel-Datei aus und füllt das Array oUserList mit neuen Usern.  
'UserList(Values):  Nachname;Vorname;Passwort;Pers-Nr;Benutzername  
'Die Spalte Benutzernamen hat dabei keine Relevanz, sie wird nur zu Infozwecken mit abgeglichen.  

Private Function GetUserDaten()
    Dim oExcelApp, oExcelSheet, aToken, sKey, sItem, sBenutzer, i
    
    GetUserDaten = False
    
    On Error Resume Next
    
    Set oExcelApp = CreateObject("Excel.Application")  
    
    With oExcelApp.Workbooks.Open(ExcelFile)
        If Err Then oExcelApp.Quit:  Exit Function

        On Error Goto 0
        
        With .Sheets(1)
            For i = ExcelStart To .Cells(.Rows.Count, "A").End(xlUp).Row  
                If .Cells(i, 1).Text <> "" Then  
                    iCountExcel = iCountExcel + 1
                   
                   '1:Nachname,2:Vorname,3:Passwort,4:Pers-Nr.  
                    aToken = .Cells(i, 1).Resize(1, 4).Value
                    
                    sBenutzer = GetAccountName(aToken(1, 2), aToken(1, 1))
                    
                   .Cells(i, 5) = sBenutzer
                    
                    If sBenutzer = "" Then  
                            Call SetLogMsg(aToken(1, 2), aToken(1, 1), "")  
                            Call SetLogErr(LogErr1)
                    ElseIf TestAccountName(sBenutzer) = False Then
                        sItem = Array(aToken(1, 1), aToken(1, 2), aToken(1, 3), aToken(1, 4), sBenutzer)
                        oUserList.Add "$" & oUserList.Count + 1, Join(sItem, ";")  
                    End If
                End If
            Next
        End With
       .Save
       .Close False
    End With

    oExcelApp.Quit:  GetUserDaten = True
End Function
'Mit dieser Funktion werden dem AD neue User hinzugefügt (ungetestet)  
'Der File-Server wird anhand des 1. Buchstabens des Benutzernamens zugeordent.  

Private Sub CreateNewUser(ByRef sNachname, ByRef sVorname, ByRef sPasswort, ByRef sPersNr, sBenutzer)
    Dim oOU, sFileServer, sCmd1, sCmd2, sErrMsg, iResult, i
    
    On Error Resume Next
    
    Select Case LCase(Left(sBenutzer, 1))
        Case "a", "b", "c", "d", "e"  
            sFileServer = "HomeDirSrv01"  
        Case "f", "g", "h", "i", "j"  
            sFileServer = "HomeDirSrv02"  
        Case "k", "l", "m", "n", "o", "p", "q", "r"  
            sFileServer = "HomeDirSrv03"  
        Case Else
            sFileServer = "HomeDirSrv04"  
    End Select
    
    Call SetLogMsg(sVorname, sNachname, sBenutzer)
   
    '#########Entsprechend anpassen  
    Set oOU = GetObject("LDAP://OU=Test,DC=DOMAIN,DC=DE")  
        
    With oOU.Create("user", "CN=" & sBenutzer)  
        .Put "sAMAccountName", sBenutzer  
        .Put "givenName", sVorname  
        .Put "sn", sNachname  
        .Put "displayName", sNachname & " " & sVorname  
        .Put "profilePath", "\\Server1\Profiles$\" & sBenutzer  
        .Put "homeDirectory", "\\" & sFileServer & "\Homedirectory$\" & sBenutzer  
        .Put "homeDrive", "P:"  
        .Put "employeeID", sPersNr  
        .Put "scriptPath", "login.bat"  
        .SetInfo
        .SetPassword sPasswort
        .AccountDisabled = False
        .SetInfo
    End With
        
    If Err Then Call SetLogErr(LogErr2):  Exit Sub
    
    iCountADS2 = iCountADS2 + 1
    
    WScript.Sleep (1000)    '???  
        
    With CreateObject("Scripting.FilesystemObject")  
        .CreateFolder ("\\" & sFileServer & "\HomeDirectory\" & sBenutzer)  
        .CreateFolder ("\\Server02\Profiles\" & sBenutzer)  
    End With
        
    If Err Then Call SetLogErr(LogErr3):  Exit Sub
    
    sCmd1 = "cacls ""\\" & sFileServer & "\HomeDirectory\" & sBenutzer & """ /t /e /c /g " & _  
            "Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C"  
        
    sCmd2 = "cacls ""\\Server02\Profiles\" & sBenutzer & """ /t /e /c /g " & _  
            "Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C"  

    With CreateObject("WScript.Shell")  
        If .Run(sCmd1, 0, True) Then Err.Raise -1
        If .Run(sCmd2, 0, True) Then Err.Raise -1
    End With
    
    If Err Then Call SetLogErr(LogErr4)
 End Sub
'Diese Funktion prüft, ob der Benutzername im ADS existiert. Rückgabe: True/False  

Private Function TestAccountName(ByRef sBenutzer)
    TestAccountName = False
    
    With oUserRec
        If sBenutzer <> "" And .EOF = False Then  
            .MoveFirst
            .Find = "sAMAccountName = '" & sBenutzer & "'"  
             If Not .EOF Then TestAccountName = True
        End If
    End With
End Function
'Diese Funktion gibt den Benutzernamen des User's aus dem ADS zurück oder erstellt einen neuen  
'Benutzernamen unter Berücksichtigung folgender Kriterien:  

'Umlaute werden ersetzt z.B. 'ü' durch 'ue'...  
'Der Benutzername hat eine maximale Länge, die durch die Konstante 'AccountLength' definiert ist.  
'Der Nachname hat dabei eine maximale Länge von AccountLength -1 und der Vorname eine Länge von 1.  
'Existiert ein Benutzername bereits, dann wird dem Nachnamen eine Ziffern zwischen 1-9 angefügt.  
'Beispiele mit den Namen: 'Müller Anton', Müller Andrea', 'Dorn Beni', 'Müller Anton', 'Dorn Boris'  
'Ergebnis: 'MuelleA', 'Muell1A', 'DornB', 'Muell2A', 'Dorn1B'  

Private Function GetAccountName(ByRef sVorname, ByRef sNachname)
    Dim aUml, sBenutzer, sV, sN, i
    
    sBenutzer = ""  
    
    With oUserRec
        If sVorname <> "" And sNachname <> "" And .EOF = False Then  
           .Sort = "SN"  
           .MoveFirst
            Do Until .EOF
           .Find = "SN = '" & sNachname & "'"  
                If Not .EOF Then
                    If LCase(.Fields("GivenName")) = LCase(sVorname) Then  
                        sBenutzer = .Fields("sAMAccountName"): Exit Do  
                    End If
                   .MoveNext
                End If
            Loop
        End If
    End With

    If sBenutzer = "" Then  
        aUml = Array("ä", "ae", "Ä", "Ae", "ö", "oe", "Ö", "Oe", "ü", "ue", "Ü", "Ue")  
    
        sV = sVorname:   sN = sNachname
        
        For i = 0 To UBound(aUml) Step 2
            sV = Replace(sV, aUml(i), aUml(i + 1))
            sN = Replace(sN, aUml(i), aUml(i + 1))
        Next
        
        sV = Left(sV, 1):  sN = Left(sN, AccountLength - 1):  sBenutzer = sN & sV
        
        If TestAccountName(sBenutzer) Then
            For i = 1 To 9
                sBenutzer = Left(sN, AccountLength - 2) & i & sV
                If TestAccountName(sBenutzer) Then sBenutzer = "" Else Exit For  
            Next
        End If
    End If
        
    GetAccountName = sBenutzer
End Function
'Diese Funktion fügt dem Log-Text eine Zeile mit dem Usernamen... hinzu  

Private Sub SetLogMsg(ByRef sMsg1, sMsg2, sMsg3)
    sLogMsg = sLogMsg & vbCrLf & "User:  " & sMsg1 & ", " & sMsg2 & ", " & sMsg3 & vbCrLf  
End Sub
'Diese Funktion fügt dem Log-Text eine Zeile mit einer Fehlermeldung hinzu  

Private Sub SetLogErr(ByRef sErr)
    sLogMsg = sLogMsg & Space(13) & sErr & " fehlgeschlagen...  " & vbCrLf  
End Sub
'Diese Funktion schreibt den Log-Text in die Log-Datei (LogFile)  

Private Sub WriteLogFile(ByRef sFile)
    Dim oFso, sHead
    
    sHead = vbCrLf & "Erstellt am:" & Space(12) & Now & vbCrLf & vbCrLf & vbCrLf & "User Gesamt:" _  
                   & Space(8) & "ADS davor:  " & iCountADS1 & Space(8) & "ADS danach:  " _  
                   & iCountADS2 & Space(8) & "Excel-Datei:  " & iCountExcel & vbCrLf & vbCrLf  
    
    Set oFso = CreateObject("Scripting.FileSystemObject")  
    
    With oFso.CreateTextFile(sFile)
        .Write sHead & sLogMsg
        .Close
    End With
End Sub

Gruß Dieter

[edit] Einen auftretenden Fehler bei leerem AD-Recordset korrigiert [/edit]
[edit] Änderungen von nachfolgenden Kommentaren wurden übernommen [/edit]
[edit] Erstellung des Benutzernamens geändert [/edit]
Member: wladislaw
wladislaw Jul 19, 2012 at 06:36:35 (UTC)
Goto Top
Hallo Dieter,

Danke für deinene Unterstützung. Ich habe deinen Script an unsere Domaine angepasst, leider bekomme ich eine Fehlermeldung:


Erstellt am: 18.07.2012 15:21:06


User Gesamt: ADS davor: ADS danach: Excel-Datei: 5


User: Pascal, User1,
Benutzername erstellen fehlgeschlagen...

User: Peter, User2,
Benutzername erstellen fehlgeschlagen...

User: Hand, User3,
Benutzername erstellen fehlgeschlagen...

User: Hubert, User4,
Benutzername erstellen fehlgeschlagen...

User: Steffi, User5,
Benutzername erstellen fehlgeschlagen...


Wie kann ich feststellen an welche Stelle bricht der Script ab.

Gruß Wladislaw
Mitglied: 76109
76109 Jul 19, 2012 at 08:14:14 (UTC)
Goto Top
Hallo Wladislaw!

Füge mal im Code mit 'Private Function GetUserDaten() ' in Codezeile 24 diese Codezeile ein:
MsgBox aToken(1, 2) & " " & aToken(1, 1) : .Close: oExcelApp.Quit: Exit Function
Die Ausgabe sollte sein: 'Vorname Nachname'

Gruß Dieter
Mitglied: 76109
76109 Jul 19, 2012 at 08:39:04 (UTC)
Goto Top
Hallo Wladislaw!

Im Code 'Private Function OpenUserRec' habe ich was vergessen einzufügen. Ersetzte diesen Codeteil
    If Err Then
        If oUserCon.State Then oUserCon.Close
        OpenUserRec = False
    Else
        OpenUserRec = True
    End If
durch diesen Codeteil
    If Err Then
        If oUserCon.State Then oUserCon.Close
        OpenUserRec = False
    Else
        iCountADS1 = oUserRec.RecordCount:  iCountADS2 = iCountADS1
        OpenUserRec = True
    End If

Gruß Dieter
Member: wladislaw
wladislaw Jul 19, 2012 at 09:28:21 (UTC)
Goto Top
Hallo Dieter,

der Sckript kann Jetzt ADS davon und danach auslesen, aber bei Erstellen der Users klappt trotzdem noch nicht

Erstellt am: 19.07.2012 11:17:11


User Gesamt: ADS davor: 0 ADS danach: 0 Excel-Datei: 5


User: Pascal, User1,
Benutzername erstellen fehlgeschlagen...

User: Peter, User2,
Benutzername erstellen fehlgeschlagen...

User: Hand, User3,
Benutzername erstellen fehlgeschlagen...

User: Hubert, User4,
Benutzername erstellen fehlgeschlagen...

User: Steffi, User5,
Benutzername erstellen fehlgeschlagen...

Meine Exclel Tabelle:

Nachname Vorname Password Pers-Nr
User1 Pascal asdff434 20070
User2 Peter wasd5555 99922
User3 Hand y434kjlk 23123
User4 Hubert fghj4lkj 63456
User5 Steffi ljöjl3kj 67456

Gruß Wladislaw
Mitglied: 76109
76109 Jul 19, 2012 updated at 13:34:20 (UTC)
Goto Top
Hallo Wladislaw!

Hast Du diese Codezeile (siehe oben 3. Quelltext) in Codezeile 24 eingefügt?
MsgBox aToken(1, 2) & " " & aToken(1, 1) : .Close: oExcelApp.Quit: Exit Function
Da sollte dann nämlich nur einmal ein Vor- und Nachname angezeigt werden und sonst nix?

Ansonsten die Codezeile wieder löschen und im 6. Quelltext
Private Function GetAccountName(ByRef sVorname, ByRef sNachname)
in Codzeile 16 diese Codezeile einfügen:
MsgBox sVorname & " " & sNachname: Exit Sub


Gruß Dieter
Member: wladislaw
wladislaw Jul 19, 2012 at 12:57:58 (UTC)
Goto Top
Hallo Dieter,

ich habe eine Änderung im 6. Quelltext unternomhmen. jetzt bekomme ich 5 MsgBoxen, aber keinen User wird erstellt. Hiermit sende ich meinen Script und Log. Könntest du den Fehler finden. Danke.

Log ------------

Erstellt am: 19.07.2012 14:32:12


User Gesamt: ADS davor: 0 ADS danach: 0 Excel-Datei: 5


User: Pascal, User1,
Benutzername erstellen fehlgeschlagen...

User: Peter, User2,
Benutzername erstellen fehlgeschlagen...

User: Hand, User3,
Benutzername erstellen fehlgeschlagen...

User: Hubert, User4,
Benutzername erstellen fehlgeschlagen...

User: Steffi, User5,
Benutzername erstellen fehlgeschlagen...


script-----------------------------


Option Explicit

Private Const ExcelFile = "\\Server\nu\wlad\Users.xls" '###Pfad anpassen
Private Const ExcelStart = 2 'Zeile mit dem 1. Eintrag

Private Const LogFile = "\\Server\nu\wlad\User.Log" '###Pfad anpassen

Private Const AccountLength = 8 'Anzahl Zeichen Benutzername

Private Const xlUp = &HFFFFEFBE 'Konstante: Excel
Private Const ADS_SCOPE_SUBTREE = 2 'Konstante: ADO-Recordset

Private Const MsgErr1 = "Datenimport vom ADS fehlgeschlagen!"
Private Const MsgErr2 = "Datemimport aus Excel-Datei fehlgeschlagen!"

Private Const LogErr1 = "Benutzername erstellen"
Private Const LogErr2 = "User dem ADS hinzufügen"
Private Const LogErr3 = "HomeDir/Profile-Verzeichnis erstellen"
Private Const LogErr4 = "HomeDir/Profile-Berechtigungen erstellen"


Private oUserCon, oUserRec, oUserList, oUser, aDaten, sLogMsg, iCountADS1, iCountADS2, iCountExcel


'Main Beg

'ADS-Daten einlesen
If OpenUserRec = False Then
MsgBox MsgErr1, vbExclamation, "Fehler...": WScript.Quit
End If

'Assoziatives Array für neue User-Daten
Set oUserList = CreateObject("Scripting.Dictionary")

'Excel-Daten einlesen und neue User im ADS anlegen
If GetUserDaten = False Then
MsgBox MsgErr2, vbExclamation, "Fehler...":
Else
For Each oUser In oUserList.Items
aDaten = Split(oUser, ";")
Call CreateNewUser(aDaten(0), aDaten(1), aDaten(2), aDaten(3), aDaten(4))
Next 'Nachname Vorname Passwort Pers-Nr. Benutzer
End If

If oUserCon.State Then oUserCon.Close

Call WriteLogFile(LogFile)

'Main End
'Diese Function Liest die User-Daten aus dem ADS in einen Recordset (ungetestet)

Private Function OpenUserRec()
Dim oUserCom

On Error Resume Next

Set oUserCon = CreateObject("ADODB.Connection")
Set oUserCom = CreateObject("ADODB.Command")

oUserCon.Provider = "ADsDSOObject"
oUserCon.Open "Active Directory Provider"

Set oUserCom.ActiveConnection = oUserCon

oUserCom.Properties("Page Size") = 1000
oUserCom.Properties("Searchscope") = ADS_SCOPE_SUBTREE

'#########Entsprechend anpassen
oUserCom.CommandText = "SELECT * FROM 'LDAP:OU=Test,DC=Ad,DC=Domain,DC=DE' WHERE ObjectCategory='user'"

Set oUserRec = oUserCom.Execute

If Err Then
If oUserCon.State Then oUserCon.Close
OpenUserRec = False
Else
iCountADS1 = oUserRec.RecordCount: iCountADS2 = iCountADS1
OpenUserRec = True
End If
End Function

'Diese Funktion liest die User-Excel-Datei aus und füllt das Array oUserList mit neuen Usern.
'UserList(Values): Nachname;Vorname;Passwort;Pers-Nr;Benutzername
'Die Spalte Benutzernamen hat dabei keine Relevanz, sie wird nur zu Infozwecken mit abgeglichen.

Private Function GetUserDaten()
Dim oExcelApp, oExcelSheet, aToken, sKey, sItem, sBenutzer, i

GetUserDaten = False

On Error Resume Next

Set oExcelApp = CreateObject("Excel.Application")

With oExcelApp.Workbooks.Open(ExcelFile)
If Err Then oExcelApp.Quit: Exit Function

With .Sheets(1)
For i = ExcelStart To .Cells(.Rows.Count, "A").End(xlUp).Row
If .Cells(i, 1).Text <> "" Then
iCountExcel = iCountExcel + 1

'1:Nachname,2:Vorname,3:Passwort,4:Pers-Nr.
aToken = .Cells(i, 1).Resize(1, 4).Value
'MsgBox aToken(1, 2) & " " & aToken(1, 1) : .Close: oExcelApp.Quit: Exit Function
sBenutzer = GetAccountName(aToken(1, 2), aToken(1, 1))

.Cells(i, 5) = sBenutzer

If sBenutzer = "" Then
Call SetLogMsg(aToken(1, 2), aToken(1, 1), "")
Call SetLogErr(LogErr1)
ElseIf TestAccountName(sBenutzer) = False Then
sItem = Array(aToken(1, 1), aToken(1, 2), aToken(1, 3), aToken(1, 4), sBenutzer)
oUserList.Add "$" & oUserList.Count + 1, Join(sItem, ";")
End If
End If
Next
End With
.Close True
End With

oExcelApp.Quit: GetUserDaten = True
End Function

'Mit dieser Funktion werden dem AD neue User hinzugefügt (ungetestet)
'Der File-Server wird anhand des 1. Buchstabens des Benutzernamens zugeordent.

Private Sub CreateNewUser(ByRef sNachname, ByRef sVorname, ByRef sPasswort, ByRef sPersNr, sBenutzer)
Dim oOU, sFileServer, sCmd1, sCmd2, sErrMsg, iResult, i

On Error Resume Next

Select Case LCase(Left(sBenutzer, 1))
Case "a", "b", "c", "d", "e"
sFileServer = "homedir01"
Case "f", "g", "h", "i", "j"
sFileServer = "homedir02"
Case "k", "l", "m", "n", "o", "p", "q", "r"
sFileServer = "homedir03"
Case Else
sFileServer = "homedir04"
End Select

Call SetLogMsg(sVorname, sNachname, sBenutzer)

'#########Entsprechend anpassen
Set oOU = GetObject("LDAP:OU=Test,DC=Ad,DC=Domain,DC=DE")

With oOU.Create("user", "CN=" & sVorname & " " & sNachname)
.Put "sAMAccountName", sBenutzer
.Put "givenName", sVorname
.Put "sn", sNachname
.Put "displayName", sNachname & " " & sVorname
.Put "profilePath", "\\Server02\Profiles$\" & sBenutzer
.Put "homeDirectory", "\\" & sFileServer & "\Homedirectory$\" & sBenutzer
.Put "homeDrive", "P:"
.Put "employeeID", sPersNr
.Put "scriptPath", "login2.bat"
.SetInfo
.SetPassword sPasswort
.AccountDisabled = False
.SetInfo
End With

If Err Then Call SetLogErr(LogErr2): Exit Sub

iCountADS2 = iCountADS2 + 1

WScript.Sleep (1000) '???

With CreateObject("Scripting.FilesystemObject")
.CreateFolder ("\\" & sFileServer & "\HomeDirectory$\" & sBenutzer)
.CreateFolder ("\\Server02\Profiles\" & sBenutzer)
End With

If Err Then Call SetLogErr(LogErr3): Exit Sub

sCmd1 = "cacls ""\\" & sFileServer & "\HomeDirectory$\" & sBenutzer & """ /t /e /c /g " & _
"Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C"

sCmd2 = "cacls ""\\Server02\Profiles$\" & sBenutzer & """ /t /e /c /g " & _
"Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C"

With CreateObject("WScript.Shell")
If .Run(sCmd1, 0, True) Then Err.Raise -1
If .Run(sCmd2, 0, True) Then Err.Raise -1
End With

If Err Then Call SetLogErr(LogErr4)
End Sub

'Diese Funktion prüft, ob der Benutzername im ADS existiert. Rückgabe: True/False

Private Function TestAccountName(ByRef sBenutzer)
TestAccountName = False

With oUserRec
If sBenutzer <> "" Then
.MoveFirst
.Find = "sAMAccountName = '" & sBenutzer & "'"
If Not .EOF Then TestAccountName = True
End If
End With
End Function

'Diese Funktion gibt den Benutzernamen des User's aus dem ADS zurück oder erstellt einen neuen
'Benutzernamen unter Berücksichtigung folgender Kriterien:

'Umlaute werden ersetzt z.B. 'ü' durch 'ue'...
'Der Benutzername hat eine vorgegebene Länge, die durch die Konstante 'AccountLength' definiert ist.
'Im Idealfall besteht der Benutzername vom 1. bis zum 2. letzten Buchstaben aus dem Nachnamen und
'dem ersten Buchstaben des Vornamen. Ansonsten wird der 2. letzte Buchstabe durch eine Ziffern 1-9
'ersetzt. Bei kürzeren Nachnamen, wird die entsprechenden Anzahl mit dem Vornamen aufgerundet.
'Beispiele mit den Namen: 'Müller Anton', Müller Andrea', 'Dorn Peter', 'Müller Anton'
'Ergebnis: 'MuelleA', 'Muell1A', 'DornPet', 'Muell2A'

Private Function GetAccountName(ByRef sVorname, ByRef sNachname)
Dim aUml, sBenutzer, sV, sN, i

sBenutzer = ""
MsgBox sVorname & " " & sNachname:
With oUserRec
If sVorname <> "" And sNachname <> "" Then
.Sort = "SN"
.MoveFirst
Do Until .EOF
.Find = "SN = '" & sNachname & "'"
If Not .EOF Then
If LCase(.Fields("GivenName")) = LCase(sVorname) Then
sBenutzer = .Fields("sAMAccountName"): Exit Do
End If
.MoveNext
End If
Loop
End If
End With

If sBenutzer = "" Then
aUml = Array("ä", "ae", "Ä", "Ae", "ö", "oe", "Ö", "Oe", "ü", "ue", "Ü", "Ue")

sV = sVorname: sN = sNachname

For i = 0 To UBound(aUml) Step 2
sV = Replace(sV, aUml(i), aUml(i + 1))
sN = Replace(sN, aUml(i), aUml(i + 1))
Next

sBenutzer = Left(Left(sN, AccountLength - 1) & sV, AccountLength)

If TestAccountName(sBenutzer) Then
For i = 1 To 9
sBenutzer = Left(Left(sN, AccountLength - 2) & i & sV, AccountLength)
If TestAccountName(sBenutzer) Then sBenutzer = "" Else Exit For
Next
End If
End If

GetAccountName = sBenutzer
End Function

'Diese Funktion fügt dem Log-Text eine Zeile mit dem Usernamen... hinzu

Private Sub SetLogMsg(ByRef sMsg1, sMsg2, sMsg3)
sLogMsg = sLogMsg & vbCrLf & "User: " & sMsg1 & ", " & sMsg2 & ", " & sMsg3 & vbCrLf
End Sub

'Diese Funktion fügt dem Log-Text eine Zeile mit einer Fehlermeldung hinzu

Private Sub SetLogErr(ByRef sErr)
sLogMsg = sLogMsg & Space(13) & sErr & " fehlgeschlagen... " & vbCrLf
End Sub

'Diese Funktion schreibt den Log-Text in die Log-Datei (LogFile)

Private Sub WriteLogFile(ByRef sFile)
Dim oFso, sHead

sHead = vbCrLf & "Erstellt am:" & Space(12) & Now & vbCrLf & vbCrLf & vbCrLf & "User Gesamt:" _
& Space(8) & "ADS davor: " & iCountADS1 & Space(8) & "ADS danach: " _
& iCountADS2 & Space(8) & "Excel-Datei: " & iCountExcel & vbCrLf & vbCrLf

Set oFso = CreateObject("Scripting.FileSystemObject")

With oFso.CreateTextFile(sFile)
.Write sHead & sLogMsg
.Close
End With
End Sub



Gruß Wladislaw
Mitglied: 76109
76109 Jul 19, 2012 updated at 13:51:22 (UTC)
Goto Top
Hallo Wladislaw!

Diese Codezeile wieder entfernen:
MsgBox aToken(1, 2) & " " & aToken(1, 1) : .Close: oExcelApp.Quit: Exit Function

Mich interessiert nur, was diese Codezeile im 6.Quellcode ausgibt (MsgBox-Ausgabe)
MsgBox "Name: " & sVorname & " " & sNachname: GetAccountName = "": Exit Function

In meinem Skript funktioniert's mit dem Benutzer, von daher kann ich den Fehler nur finden, wenn ich weiß, was bei Dir an dieser Stelle ausgegeben wirdface-wink

Gruß Dieter

[edit] Codezeile enthielt einen Fehler (korrigiert) [/edit]
Member: wladislaw
wladislaw Jul 19, 2012 at 15:08:15 (UTC)
Goto Top
Hallo Dieter,

ich habe die Änderung vorgenommen. Es kommen wieder 5 Popup Fensterchen, aber keinen User wurde erstellt

Änderung----------

Private Function GetAccountName(ByRef sVorname, ByRef sNachname)
Dim aUml, sBenutzer, sV, sN, i

sBenutzer = ""
MsgBox "Name: " & sVorname & " " & sNachname: GetAccountName = "": Exit Function
With oUserRec
If sVorname <> "" And sNachname <> "" Then
.Sort = "SN"
.MoveFirst
Do Until .EOF
.Find = "SN = '" & sNachname & "'"
If Not .EOF Then
If LCase(.Fields("GivenName")) = LCase(sVorname) Then
sBenutzer = .Fields("sAMAccountName"): Exit Do
End If
.MoveNext
End If
Loop
End If
End With
LOG-----------------------------------
Erstellt am: 19.07.2012 17:01:02


User Gesamt: ADS davor: 0 ADS danach: 0 Excel-Datei: 5


User: Pascal, User1,
Benutzername erstellen fehlgeschlagen...

User: Peter, User2,
Benutzername erstellen fehlgeschlagen...

User: Hand, User3,
Benutzername erstellen fehlgeschlagen...

User: Hubert, User4,
Benutzername erstellen fehlgeschlagen...

User: Steffi, User5,
Benutzername erstellen fehlgeschlagen...
Gruß Wladislaw
Mitglied: 76109
76109 Jul 19, 2012 updated at 17:15:31 (UTC)
Goto Top
Hallo Wladislaw!

Ist ja schön, dass Du 5 Popup's bekommst, wäre auch toll, wenn Du mir mitteilen könntest, was den nun in den Popups zu sehen bzw. zu lesen ist??? Ich kann sie von hier aus leider nicht sehenface-wink

Gruß Dieter


PS. Im Quellcode mit 'Private Function GetUserDaten' die Codezeile 39 eingefügt und Codezeile 40 geändert in:
 .Save
 .Close False
Member: wladislaw
wladislaw Jul 19, 2012 at 20:08:37 (UTC)
Goto Top
Hallo Dieter,

kann ich dir irgendwie einen screenshot senden?

Gruß Wladislaw
Member: bastla
bastla Jul 19, 2012 updated at 20:30:11 (UTC)
Goto Top
Hallo wladislaw und Dieter!

Macht doch aus der "MsgBox" ein "WScript.Echo" - dann noch per
cscript user.vbs>D:\Log.txt
starten und die Ausgaben der entstandenen Datei entnehmen ...

Bei Ausführung über "wscript" werden übrigens die "WScript.Echo"-Ausgaben ohnehin als (Standard-)"MsgBox" angezeigt.

Grüße
bastla
Mitglied: 76109
76109 Jul 19, 2012 updated at 21:03:22 (UTC)
Goto Top
Hallo bastla!

Macht doch aus der "MsgBox" ein "WScript.Echo" - dann noch per...
Ist natürlich auch eine Möglichkeit. Ich verstehe nur nicht ganz, was daran so schwer sein soll, zu beschreiben was die Popups anzeigen (max 5 Vor- und Nachnamen oder auch nicht?)?

Und danke für die Unterstützungface-wink

Gruß Dieter
Member: wladislaw
wladislaw Jul 20, 2012 at 06:16:04 (UTC)
Goto Top
Hallo Dieter und bastla,

in jedem Popups (mit MsgBox) werden die einzelne User angezeig
Name: Pascal User1
Name: Peter User2
Name: Hand User3
Name: Hubert User4
Name: Stefi User5

Hiermit noch einen Ausschnitt aus Log datei mit WScript.Echo
Microsoft (R) Windows Script Host, Version 5.8
Copyright (C) Microsoft Corporation 1996-2001. Alle Rechte vorbehalten.

Name: Pascal User1
Name: Peter User2
Name: Hand User3
Name: Hubert User4
Name: Steffi User5


Gruß Wladislaw
Mitglied: 76109
76109 Jul 20, 2012 updated at 08:53:22 (UTC)
Goto Top
Hallo Zusammen!

Hab den Fehler gefundenface-wink

@wladislaw
Ersetze die komplette Function 'Private Function GetAccountName' durch diese:
Private Function GetAccountName(ByRef sVorname, ByRef sNachname)
    Dim aUml, sBenutzer, sV, sN, i
    
    sBenutzer = ""  
    
    With oUserRec
        If sVorname <> "" And sNachname <> "" And .EOF = False Then  
           .Sort = "SN"  
           .MoveFirst
            Do Until .EOF
           .Find = "SN = '" & sNachname & "'"  
                If Not .EOF Then
                    If LCase(.Fields("GivenName")) = LCase(sVorname) Then  
                        sBenutzer = .Fields("sAMAccountName"): Exit Do  
                    End If
                   .MoveNext
                End If
            Loop
        End If
    End With

    If sBenutzer = "" Then  
        aUml = Array("ä", "ae", "Ä", "Ae", "ö", "oe", "Ö", "Oe", "ü", "ue", "Ü", "Ue")  
    
        sV = sVorname:   sN = sNachname
        
        For i = 0 To UBound(aUml) Step 2
            sV = Replace(sV, aUml(i), aUml(i + 1))
            sN = Replace(sN, aUml(i), aUml(i + 1))
        Next
        
        sBenutzer = Left(Left(sN, AccountLength - 1) & sV, AccountLength)
        
        If TestAccountName(sBenutzer) Then
            For i = 1 To 9
                sBenutzer = Left(Left(sN, AccountLength - 2) & i & sV, AccountLength)
                If TestAccountName(sBenutzer) Then sBenutzer = "" Else Exit For  
            Next
        End If
    End If
        
    GetAccountName = sBenutzer
End Function
Der Fehler entsteht wenn der AD-Recordset leer ist (EOF)face-wink

Und ersetze in der Function 'Private Function GetUserDaten' diese Codezeile:
        If Err Then oExcelApp.Quit:  Exit Function
durch diese Codezeilen
        If Err Then oExcelApp.Quit:  Exit Function
        
        On Error GoTo 0

Ersetzte auch die Function 'TestAccountName' durch diese:
'Diese Funktion prüft, ob der Benutzername im ADS existiert. Rückgabe: True/False  

Private Function TestAccountName(ByRef sBenutzer)
    TestAccountName = False
    
    With oUserRec
        If sBenutzer <> "" And .EOF = False Then  
            .MoveFirst
            .Find = "sAMAccountName = '" & sBenutzer & "'"  
             If Not .EOF Then TestAccountName = True
        End If
    End With
End Function

Die zum Testen eingefügten MsgBoxen/WScript.Echos kannst Du auch wieder entfernen


Gruß Dieter

PS. Die Quellcodes weiter oben wurden auch entsprechend geändert
Member: wladislaw
wladislaw Jul 20, 2012 at 13:26:35 (UTC)
Goto Top
Hallo Dieter,

Super. Danke. Grundsätzlich funktioniert. !!!!!!!!!!!!face-smileface-smileface-smile


ich habe gerade eine Unstimmigkeit festgestellt.
Der UserName ("CN=") muss bestehen nur aus ersten 6 Buchstaben von Nachname + nur erste Buchstabe des Vornamens und der Name darf nur 7 Zeichnungen ohne umlaute erhalten.

Ich habe bei mir in "Private Sub CreateNewUser(ByRef sNachname, ByRef sVorname, ByRef sPasswort, ByRef sPersNr, sBenutzer)" die Codezeile 25 geändert in:

With oOU.Create("user", "CN=" & sNachname & "" & sVorname)

z.B. jetzt nach dem Scriptablauf bekomme ich in ADS:

Directory Name Display Name DN

User1Marcus User1 Marcus CN=User1Marcus,OU=Test,DC=AD,DC=Domain,DC=DE
User2Michael User2 Michael CN=User2Michael,OU=Test,DC=AD,DC=Domain,DC=DE
User3Hand User3 Hand CN=User3Hand,OU=Test,DC=AD,DC=Domain,DC=DE
Userö5Steffi Userö5 Steffi CN=Userö5Steffi,OU=Test,DC=AD,DC=Domain,DC=DE
Userü4Hubert Userü4 Hubert CN=Userü4Hubert,OU=Test,DC=AD,DC=Domain,DC=DE

ich brauche:

Directory Name Display Name

User1M User1 Marcus
User2M User2 Michael
User3H User3 Hand
UseroeS Userö5 Steffi
UserueH Userü4 Hubert

Befor ich "sNachname" mit "sVorname" in der die Codezeile 25 getausch habe, waren die Namen auch falsch

Directory Name Display Name

HandUser3 User3 Hand
HubertUserü4 Userü4 Hubert
MarcusUser1 User1 Marcus
MichaelUser2 User2 Michael
SteffiUserö5 Userö5 Steffi


in Log Datei werden Usernamen teilweise richtig (ohne Umlaute) Angezeigt.

Erstellt am: 20.07.2012 14:20:38


User Gesamt: ADS davor: ADS danach: 5 Excel-Datei: 5


User: Marcus, User1, User1Ma

User: Michael, User2, User2Mi

User: Hand, User3, User3Ha

User: Hubert, Userü4, UserueH

User: Steffi, Userö5, UseroeS


Gruß Wladislaw
Member: wladislaw
wladislaw Jul 20, 2012 at 13:43:54 (UTC)
Goto Top
Hall Dieter,

ich habe vergessen dir zu sagen, Excel Tabelle wird auch ohne Umlaute gefüllt, aber UserName besteht auch nicht aus ersten 6 Buchstaben von Nachname + nur erste Buchstabe des Vornamens

Nachname Vorname Password Pers.Nr
User1 Marcus asdf2ol 20070 User1Ma
User2 Michael wasdoii 99922 User2Mi
User3 Hand yxclkjlk 23123 User3Ha
Userü4 Hubert fghjlkj 63456 UserueH
Userö5 Steffi ljöjlkj 67456 UseroeS

Gruß Wladislaw
Mitglied: 76109
76109 Jul 20, 2012 updated at 14:28:55 (UTC)
Goto Top
Hallo Wladislaw!

Irgendwie blicke ich in diesem Durcheinander im Moment überhaupt nicht durchface-wink
Wenn Du diese Codezeile:
With oOU.Create("user", "CN=" & sVorname & " " & sNachname)
durch diese ersetzt
With oOU.Create("user", "CN=" & sBenutzer)
siehts vielleicht schonmal besser aus

Gruß Dieter
Member: wladislaw
wladislaw Jul 21, 2012 at 21:32:25 (UTC)
Goto Top
Hallo Dieter,

Danke. es funktioniert. face-smileface-smile
Noch eine Frage. Wie kann ich bei UserName so abgrenzen, dass der Name nur aus ersten 6 Buchstaben von Nachname + nur erste Buchstabe des Vornamens besteht.;)

Gruß Wladislaw
Mitglied: 76109
76109 Jul 22, 2012 updated at 08:09:10 (UTC)
Goto Top
Hallo wladislaw!

Danke. es funktioniert...
Freut mich zu hörenface-wink

Noch eine Frage. Wie kann ich bei UserName so abgrenzen, dass der Name nur aus ersten 6 Buchstaben von Nachname + nur erste Buchstabe des Vornamens besteht.;)
An welcher Stelle?

Grundsätzlich beinnhaltet im die Variable 'sBenutzername' den gebastelten Namen aus Nachname & Vorname mit 7 Zeichenface-wink


Gruß Dieter
Member: wladislaw
wladislaw Jul 23, 2012 at 08:38:36 (UTC)
Goto Top
Hallo Dieter,

Sorry für sollche Komplexität mit Username.

ich habe die Codezeile 43 und 47 aus "Private Function GetAccountName(ByRef sVorname, ByRef sNachname)" geändert in:

sBenutzer = Left(Left(sN, AccountLength - 1) & Left(sV, 1), AccountLength)
...
sBenutzer = Left(Left(sN, AccountLength - 2) & i & Left(sV, 1), AccountLength)

Damit bekomme ich entsprechenden Username: maximal ersten 6 Buchstaben von Nachname + nur erste Buchstabe des Vornamens und der Name darf maximal bis zu 7 Zeichnungen alles ohne umlaute erhalten .

was ich noch nicht erreichen kann, sobald ich z.B.
Variante1: zwei "User Markus "
oder Variante2: einen "User Marcus" und einen "User Michael" habe, es wird nur einen User "UserM" erstellt und der Rest der Users wird ignoriert. Mein Ziel: es müssen 3 users mit Namen: "UserM; User1M; User2M" erstellt werden. Das heist: zwischen Nachname und Vorname man muss eine Ziffer von 1 bis 9 eingetragen werden und "Namen Konstellation" in dem fall wird geändert in: maximal ersten 5 Buchstaben von Nachname + Ziffer (von1 bis9) + nur erste Buchstabe des Vornamens und der Name darf maximal bis zu 7 Zeichnungen alles ohne umlaute erhalten.
Excel----------------------------
Nachname Vorname Password Pers.Nr
User Marcus asdf2ol 20070 UserM
User Michael wasdoii 99922 UserM
User Markus yxclkjl 23123 UserM
Userü4 Hubert fghjlkj 63456 UserueH
Userö5 Steffi ljöjlkj 67456 UseroeS

Log------------


Erstellt am: 23.07.2012 09:43:10

User Gesamt: ADS davor: ADS danach: 3 Excel-Datei: 5

User: Marcus, User, UserM

User: Michael, User, UserM
User dem ADS hinzufügen fehlgeschlagen...

User: Markus, User, UserM
User dem ADS hinzufügen fehlgeschlagen...

User: Hubert, Userü4, UserueH

User: Steffi, Userö5, UseroeS

Gruß Wladislaw
Mitglied: 76109
76109 Jul 25, 2012 updated at 20:46:20 (UTC)
Goto Top
Hallo Wladislaw!

Obigen Quellcode 'Private Function GetAccountName(ByRef sVorname, ByRef sNachname)' entsprechend geändert.

Hoffe, die Benutzernamen werden jetzt richtig erstelltface-wink

Beispiele mit den Namen:
'Müller Anton', Müller Andrea', 'Dorn Beni', 'Müller Anton', 'Dorn Boris'

Ergebnis Benutzername: 'MuelleA', 'Muell1A', 'DornB', 'Muell2A', 'Dorn1B'


Gruß Dieter
Member: wladislaw
wladislaw Jul 26, 2012 at 11:49:22 (UTC)
Goto Top
Hallo Dieter,

Danke für deine Hilfe. Leider es hat nicht geklappt. face-sad

Nach Codeänderung bleibt wie vorher: die Namen wurden falsch erstellt.

Excel------------------
Nachname Vorname Password Pers.Nr
Müller Anton asdf2ol 20070 MuellA
Müller Andrea wasdoii 99922 MuellA
Dorn Beni yxclkjlk 23123 DornB
Müller Anton fghjlkj 63456 MuellA
Dorn Boris ljöjlkj 67456 DornB

LOG----------------------


Erstellt am: 26.07.2012 16:28:47


User Gesamt: ADS davor: ADS danach: 2 Excel-Datei: 5


User: Anton, Müller, MuellA

User: Andrea, Müller, MuellA
User dem ADS hinzufügen fehlgeschlagen...

User: Beni, Dorn, DornB

User: Anton, Müller, MuellA
User dem ADS hinzufügen fehlgeschlagen...

User: Boris, Dorn, DornB
User dem ADS hinzufügen fehlgeschlagen...


Gruß Wladislaw
Mitglied: 76109
76109 Jul 26, 2012 updated at 13:46:04 (UTC)
Goto Top
Hallo Wladislaw!

Die Function für die Erstellung funktioniert schon richtig, aber mir ist gerade eingefallen, warum das trotzdem nicht funktioniert. Der Grund dafür ist der, dass die Daten vom AD ja nur einmal zu Begin in den AD-Recordset eingelesen werden. d.h. nach jeder neuen Benutzer-Erstellung, müssen die Daten auch dem AD-Recordset hinzugefügt oder besser die Daten aus dem AD neu eingelesen werden, ist zumindest sicherer, falls die User-Erstellung im AD fehlgeschlagen hat. Daran hatte ich leider nicht gedachtface-sad

Im Moment habe ich aber wenig Zeit, von daher dauerts ein wenigface-wink


Gruß Dieter
Mitglied: 76109
76109 Jul 26, 2012, updated at Aug 11, 2012 at 07:50:59 (UTC)
Goto Top
Hallo Wladislaw!

Hier mal ein neues etwas vereinfachtes Script. Hoffe, dass ich mit Copy/Paste nix vergessen habface-wink

Option Explicit

Private Const ExcelFile = "E:\Test\User.xls"  
Private Const ExcelStart = 2            'Zeile mit dem 1. Eintrag  

Private Const LogFile = "E:\Test\User.Log"  

Private Const AccountLength = 7         'Anzahl Zeichen für Benutzername  

Private Const xlUp = &HFFFFEFBE         'Konstante: Excel  
Private Const ADS_SCOPE_SUBTREE = 2     'Konstante: ADO-Recordset  

Private Const MsgErr1 = "Datenimport vom ADS fehlgeschlagen!"  
Private Const MsgErr2 = "Datemimport aus Excel-Datei fehlgeschlagen!"  

Private Const LogErr1 = "Benutzername erstellen"  
Private Const LogErr2 = "User dem ADS hinzufügen"  
Private Const LogErr3 = "HomeDir/Profile-Verzeichnis erstellen"  
Private Const LogErr4 = "HomeDir/Profile-Berechtigungen erstellen"  

Private oUserList, oNewUserList, oUser, aDaten, sLogMsg, iCountADS1, iCountADS2, iCountExcel


'Main Beg  

    'Assoziatives Arrays für User-Daten  
    Set oUserList = CreateObject("Scripting.Dictionary")    'User-Bestand  
    Set oNewUserList = CreateObject("Scripting.Dictionary") 'User-Neu hinzufügen  
    
    'ADS-Daten einlesen  
    If OpenUserRec = False Then
        MsgBox MsgErr1, vbExclamation, "Fehler...":  WScript.Quit  
    End If
    
    'Excel-Daten einlesen und neue User im ADS anlegen  
    If GetUserDaten = False Then
        MsgBox MsgErr2, vbExclamation, "Fehler...":  WScript.Quit  
    Else
        For Each oUser In oNewUserList.Items
            aDaten = Split(oUser, ";")  
            Call CreateNewUser(aDaten(0), aDaten(1), aDaten(2), aDaten(3), aDaten(4))
        Next                  'Nachname   Vorname    Passwort   Pers-Nr.   Benutzer  
    End If
    
    Call WriteLogFile(LogFile)
    
    Set oUserList = Nothing
    Set oNewUserList = Nothing

'Main End  


'Diese Function Liest die User-Daten aus dem ADS in einen Recordset (ungetestet)  

Private Function OpenUserRec()
    Dim oUserCon, oUserCom, oUserRec
    
    On Error Resume Next
    
    Set oUserCon = CreateObject("ADODB.Connection")  
    Set oUserCom = CreateObject("ADODB.Command")  
    
    oUserCon.Provider = "ADsDSOObject"  
    oUserCon.Open "Active Directory Provider"  
    
    Set oUserCom.ActiveConnection = oUserCon
    
    oUserCom.Properties("Page Size") = 1000  
    oUserCom.Properties("Searchscope") = ADS_SCOPE_SUBTREE  
    
    '#########Entsprechend anpassen  
    oUserCom.CommandText = "SELECT * FROM 'LDAP://DC=Test,DC=DOMAIN,DC=DE' WHERE ObjectCategory='user'"  
        
    Set oUserRec = oUserCom.Execute
    
    If Err Then
        OpenUserRec = False
    Else
        OpenUserRec = True

        With oUserRec
            If .RecordCount Then
               .Sort = "sAMAccountName"  
               .MoveFirst
                Do Until .EOF
                    oUserList.Add .Fields("sAMAccountName").Value, _  
                                  .Fields("SN").Value & ";" & .Fields("GivenName").Value  
                   .MoveNext
                Loop
            End If
        End With
        
        iCountADS1 = oUserList.Count:   iCountADS2 = iCountADS1
    End If
    
    If oUserCon.State Then oUserRec.Close:  oUserCon.Close
End Function

'Diese Funktion liest die User-Excel-Datei aus und füllt das Array oNewUserList mit neuen Usern.  
'NewUserList(Values):  Nachname;Vorname;Passwort;Pers-Nr;Benutzername  
'Die Spalte Benutzernamen hat dabei keine Relevanz, sie wird nur zu Infozwecken mit abgeglichen.  

Private Function GetUserDaten()
    Dim oExcelApp, oExcelSheet, aToken, sKey, sItem, sBenutzer, i
    
    GetUserDaten = False
    
    On Error Resume Next
    
    Set oExcelApp = CreateObject("Excel.Application")  
    
    With oExcelApp.Workbooks.Open(ExcelFile)
        If Err Then oExcelApp.Quit:  Exit Function
        
        On Error GoTo 0
        
        With .Sheets(1)
            For i = ExcelStart To .Cells(.Rows.Count, "A").End(xlUp).Row  
                If .Cells(i, 1).Text <> "" Then  
                    iCountExcel = iCountExcel + 1
                   
                   '1:Nachname,2:Vorname,3:Passwort,4:Pers-Nr.  
                    aToken = .Cells(i, 1).Resize(1, 4).Value
                    
                    sBenutzer = GetAccountName(aToken(1, 2), aToken(1, 1))
                    
                   .Cells(i, 5) = sBenutzer
                    
                    If sBenutzer = "" Then  
                            Call SetLogMsg(aToken(1, 2), aToken(1, 1), "")  
                            Call SetLogErr(LogErr1)
                    ElseIf oUserList.Exists(sBenutzer) = False Then
                        sItem = Array(aToken(1, 1), aToken(1, 2), aToken(1, 3), aToken(1, 4), sBenutzer)
                        oNewUserList.Add "$" & oNewUserList.Count + 1, Join(sItem, ";")  
                    End If
                End If
            Next
        End With
       .Save
       .Close False
    End With

    oExcelApp.Quit:  GetUserDaten = True
End Function

'Mit dieser Funktion werden dem AD neue User hinzugefügt (ungetestet)  
'Der File-Server wird anhand des 1. Buchstabens des Benutzernamens zugeordent.  

Private Sub CreateNewUser(ByRef sNachname, ByRef sVorname, ByRef sPasswort, ByRef sPersNr, sBenutzer)
    Dim oOU, sFileServer, sCmd1, sCmd2, sErrMsg, iResult, i
    
    On Error Resume Next
    
    Select Case LCase(Left(sBenutzer, 1))
        Case "a", "b", "c", "d", "e"  
            sFileServer = "HomeDirSrv01"  
        Case "f", "g", "h", "i", "j"  
            sFileServer = "HomeDirSrv02"  
        Case "k", "l", "m", "n", "o", "p", "q", "r"  
            sFileServer = "HomeDirSrv03"  
        Case Else
            sFileServer = "HomeDirSrv04"  
    End Select
    
    Call SetLogMsg(sVorname, sNachname, sBenutzer)
   
    '#########Entsprechend anpassen  
    Set oOU = GetObject("LDAP://OU=Test,DC=DOMAIN,DC=DE")  
        
    With oOU.Create("user", "CN=" & sBenutzer)  
        .Put "sAMAccountName", sBenutzer  
        .Put "givenName", sVorname  
        .Put "sn", sNachname  
        .Put "displayName", sNachname & " " & sVorname  
        .Put "profilePath", "\\Server1\Profiles$\" & sBenutzer  
        .Put "homeDirectory", "\\" & sFileServer & "\Homedirectory$\" & sBenutzer  
        .Put "homeDrive", "P:"  
        .Put "employeeID", sPersNr  
        .Put "scriptPath", "login.bat"  
        .SetInfo
        .SetPassword sPasswort
        .AccountDisabled = False
        .SetInfo
    End With
        
    If Err Then 
        Call SetLogErr(LogErr2):  Exit Sub
    Else
        oUserList.Add sBenutzer, sNachname & ";" & sVorname  
    End If
    
    iCountADS2 = iCountADS2 + 1
    
    WScript.Sleep (1000)
        
    With CreateObject("Scripting.FilesystemObject")  
        .CreateFolder ("\\" & sFileServer & "\HomeDirectory\" & sBenutzer)  
        .CreateFolder ("\\Server02\Profiles\" & sBenutzer)  
    End With
        
    If Err Then Call SetLogErr(LogErr3):  Exit Sub
    
    sCmd1 = "cacls ""\\" & sFileServer & "\HomeDirectory\" & sBenutzer & """ /t /e /c /g " & _  
            "Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C"  
        
    sCmd2 = "cacls ""\\Server02\Profiles\" & sBenutzer & """ /t /e /c /g " & _  
            "Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C"  

    With CreateObject("WScript.Shell")  
        If .Run(sCmd1, 0, True) Then Err.Raise -1
        If .Run(sCmd2, 0, True) Then Err.Raise -1
    End With
    
    If Err Then Call SetLogErr(LogErr4)
 End Sub


'Diese Funktion gibt den Benutzernamen des User's aus dem ADS zurück oder erstellt einen neuen  
'Benutzernamen unter Berücksichtigung folgender Kriterien:  

'Umlaute werden ersetzt z.B. 'ü' durch 'ue'...  
'Der Benutzername hat eine vorgegebene Länge, die durch die Konstante 'AccountLength' definiert ist.  
'Im Idealfall besteht der Benutzername vom 1. bis zum 2. letzten Buchstaben aus dem Nachnamen und  
'dem ersten Buchstaben des Vornamen. Ansonsten wird der 2. letzte Buchstabe durch eine Ziffern 1-9  
'ersetzt. Bei kürzeren Nachnamen, wird die entsprechenden Anzahl mit dem Vornamen aufgerundet.  
'Beispiele mit den Namen: 'Müller Anton', Müller Andrea', 'Dorn Peter', 'Müller Anton'  
'Ergebnis: 'MuelleA', 'Muell1A', 'DornP', 'Muell2A'  

Private Function GetAccountName(ByRef sVorname, ByRef sNachname)
    Dim oUser, aUser, aUml, sBenutzer, sV, sN, i, x
    
    sBenutzer = ""  
    
    For Each oUser In oUserList
        If LCase(oUserList(oUser)) = LCase(sNachname & ";" & sVorname) Then  
            sBenutzer = oUser:  Exit For
        End If
    Next

    If sBenutzer = "" Then  
        aUml = Array("ä", "ae", "Ä", "Ae", "ö", "oe", "Ö", "Oe", "ü", "ue", "Ü", "Ue")  
    
        sV = sVorname:   sN = sNachname
        
        For i = 0 To UBound(aUml) Step 2
            sV = Replace(sV, aUml(i), aUml(i + 1))
            sN = Replace(sN, aUml(i), aUml(i + 1))
        Next
        
        sV = Left(sV, 1):  sN = Left(sN, AccountLength - 1):  sBenutzer = sN & sV
        
        If oUserList.Exists(sBenutzer) Then
            For i = 1 To 9
                sBenutzer = Left(sN, AccountLength - 2) & i & sV
                If oUserList.Exists(sBenutzer) Then sBenutzer = "" Else Exit For  
            Next
        End If
    End If
End Function

'Diese Funktion fügt dem Log-Text eine Zeile mit dem Usernamen... hinzu  
Private Sub SetLogMsg(ByRef sMsg1, sMsg2, sMsg3)
    sLogMsg = sLogMsg & vbCrLf & "User:  " & sMsg1 & ", " & sMsg2 & ", " & sMsg3 & vbCrLf  
End Sub

'Diese Funktion fügt dem Log-Text eine Zeile mit einer Fehlermeldung hinzu  
Private Sub SetLogErr(ByRef sErr)
    sLogMsg = sLogMsg & Space(13) & sErr & " fehlgeschlagen...  " & vbCrLf  
End Sub

'Diese Funktion schreibt den Log-Text in die Log-Datei (LogFile)  
Private Sub WriteLogFile(ByRef sFile)
    Dim oFso, sHead
    
    sHead = vbCrLf & "Erstellt am:" & Space(12) & Now & vbCrLf & vbCrLf & vbCrLf & "User Gesamt:" _  
                   & Space(8) & "ADS davor:  " & iCountADS1 & Space(8) & "ADS danach:  " _  
                   & iCountADS2 & Space(8) & "Excel-Datei:  " & iCountExcel & vbCrLf & vbCrLf  
    
    Set oFso = CreateObject("Scripting.FileSystemObject")  
    
    With oFso.CreateTextFile(sFile)
        .Write sHead & sLogMsg
        .Close
    End With
End Sub

Gruß Dieter

[edit] Codezeile 115 noch eingefügt und einen Fehler korrigiert [/edit]
[edit] Copy/Paste-Fehler korrigiert [/edit]
Member: wladislaw
wladislaw Aug 06, 2012 at 11:54:45 (UTC)
Goto Top
Hallo Dieter,
Danke für dein neues Script face-smile, leider funktioniert es nicht face-sad

PS: Es werden keine neue Einträge / UserName (in der 5 Spalte) in Excel automatisch eingetragen.

Excel------------
Nachname Vorname Password Pers.Nr
Usörrs Anton asdf2ol 20070
Usörrs Andrea wasdoii 99922
User Beni yxclkjlk 23123
Usörrs Anton fghjlkj 63456
User Boris ljöjlkj 67456

LOG-----------------


Erstellt am: 06.08.2012 13:45:09


User Gesamt: ADS davor: ADS danach: Excel-Datei: 5


User: Anton, Usörrs,
Benutzername erstellen fehlgeschlagen...

User: Andrea, Usörrs,
Benutzername erstellen fehlgeschlagen...

User: Beni, User,
Benutzername erstellen fehlgeschlagen...

User: Anton, Usörrs,
Benutzername erstellen fehlgeschlagen...

User: Boris, User,
Benutzername erstellen fehlgeschlagen...


Gruß Wladislaw
Mitglied: 76109
76109 Aug 08, 2012 at 14:20:03 (UTC)
Goto Top
Hallo Wladislaw!

Sorry, da hatte ich bei Copy/Paste doch Mist gebautface-sad

Hab's im Quelltext entsprechend geändertface-wink


Gruß Dieter
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
AlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 1 CommentDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment