Cookies erleichtern die Bereitstellung unserer Dienste. Mit der Nutzung unserer Dienste erklärst du dich damit einverstanden, dass wir Cookies verwenden Mehr InfosVerstanden

Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Frage Entwicklung VB for Applications
gelöst VBScript für automatische User Erstellung im AD

Mitglied: wladislaw

wladislaw (Level 1) - Jetzt verbinden

09.07.2012 um 16:41 Uhr, 7182 Aufrufe, 37 Kommentare

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
An Google+ senden
37 Antworten
Mitglied: 76109
76109 (Level 3)
09.07.2012, aktualisiert um 19:39 Uhr
Hallo wladislaw!

Eventuell könnte man das Ganze in's VB-Script mit einbauen:
Quelltext | Drucken
01.
    Dim arrCmdLines, strCmdLine, strUserName, strFileServer, i 
02.
 
03.
    strUserName = InputBox("Bitte Username eingeben:", "Username...") 
04.
     
05.
    Select Case LCase(Left(strUserName, 1)) 
06.
        Case "" 
07.
            MsgBox "Abbruch oder Leereingabe!", vbInformation, "Hinweis...":   WScript.Quit 1 
08.
        Case "a", "b", "c", "d", "e" 
09.
            strFileServer = "Homedirsrv01" 
10.
        Case "f", "g", "h", "i", "j" 
11.
            strFileServer = "Homedirsrv02" 
12.
        Case "k", "l", "m", "n", "o", "p", "q", "r" 
13.
            strFileServer = "Homedirsrv03" 
14.
        Case Else 
15.
            strFileServer = "Homedirsrv04" 
16.
    End Select 
17.
 
18.
    arrCmdLines = Array("md ""\\%1\HomeDirectory\%2""", _ 
19.
                       "cacls ""\\%1\HomeDirectory\%2"" /t /e /c /g ""Domain\Domänen-Admins"":F", _ 
20.
                       "cacls ""\\%1\HomeDirectory\%2"" /t /e /c /g ""Domain\%2"":c", _ 
21.
                       "md ""\\Server02\profiles\%2""", _ 
22.
                       "cacls ""\\Server02\profiles\%2"" /t /e /c /g ""Domain\Domänen-Admins"":F", _ 
23.
                       "cacls ""\\Server02\profiles\%2"" /t /e /c /g ""Domain\%2"":c") 
24.
     
25.
 
26.
    For i = 0 To UBound(arrCmdLines) 
27.
        arrCmdLines(i) = Replace(Replace(arrCmdLines(i), "%1", strFileServer), "%2", strUserName) 
28.
    Next 
29.
 
30.
     
31.
    With CreateObject("WScript.Shell") 
32.
        For Each strCmdLine In arrCmdLines 
33.
             MsgBox strCmdLine                  'Test: Ausgabe der CmdLines 
34.
           '.Run strCmdLine,0,True 
35.
        Next 
36.
    End With
Und siehe Dir mal die Formatierungshilfe an. Stichwort: Code-Tags

Gruß Dieter
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
10.07.2012 um 14:23 Uhr
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 (Level 3)
10.07.2012 um 16:57 Uhr
Hallo Wladislaw!

Kein Problem

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

Gruß Dieter
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
11.07.2012 um 08:30 Uhr
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 (Level 3)
11.07.2012 um 10:54 Uhr
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
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
11.07.2012 um 14:32 Uhr
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 (Level 3)
11.07.2012, aktualisiert um 19:19 Uhr
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
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
12.07.2012 um 10:44 Uhr
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 (Level 3)
12.07.2012, aktualisiert um 11:45 Uhr
Hallo Wladislaw!

Du hast mich leider völlig missverstanden

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 auszugeben 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 gefragt

Gruß Dieter
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
12.07.2012 um 15:07 Uhr
Halo Dieter,

ja, ich habe dicht missverstanden.

Könntest du bitte in deine Routine (wenn noch möglich ist )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 (Level 3)
15.07.2012, aktualisiert 25.07.2012
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.

Quelltext | Drucken
01.
Option Explicit 
02.
 
03.
Private Const ExcelFile = "E:\Test\User.xls"   '###Pfad anpassen 
04.
Private Const ExcelStart = 2                   'Zeile mit dem 1. Eintrag 
05.
 
06.
Private Const LogFile = "E:\Test\User.Log"     '###Pfad anpassen 
07.
 
08.
Private Const AccountLength = 7                'Anzahl Zeichen Benutzername 
09.
 
10.
Private Const xlUp = &HFFFFEFBE                'Konstante: Excel 
11.
Private Const ADS_SCOPE_SUBTREE = 2            'Konstante: ADO-Recordset 
12.
 
13.
Private Const MsgErr1 = "Datenimport vom ADS fehlgeschlagen!" 
14.
Private Const MsgErr2 = "Datemimport aus Excel-Datei fehlgeschlagen!" 
15.
 
16.
Private Const LogErr1 = "Benutzername erstellen" 
17.
Private Const LogErr2 = "User dem ADS hinzufügen" 
18.
Private Const LogErr3 = "HomeDir/Profile-Verzeichnis erstellen" 
19.
Private Const LogErr4 = "HomeDir/Profile-Berechtigungen erstellen" 
20.
 
21.
 
22.
Private oUserCon, oUserRec, oUserList, oUser, aDaten, sLogMsg, iCountADS1, iCountADS2, iCountExcel 
23.
 
24.
 
25.
'Main Beg 
26.
 
27.
    'ADS-Daten einlesen 
28.
    If OpenUserRec = False Then 
29.
        MsgBox MsgErr1, vbExclamation, "Fehler...":  WScript.Quit 
30.
    End If 
31.
     
32.
    'Assoziatives Array für neue User-Daten 
33.
    Set oUserList = CreateObject("Scripting.Dictionary") 
34.
     
35.
    'Excel-Daten einlesen und neue User im ADS anlegen 
36.
    If GetUserDaten = False Then 
37.
        MsgBox MsgErr2, vbExclamation, "Fehler...": 
38.
    Else 
39.
        For Each oUser In oUserList.Items 
40.
            aDaten = Split(oUser, ";") 
41.
            Call CreateNewUser(aDaten(0), aDaten(1), aDaten(2), aDaten(3), aDaten(4)) 
42.
        Next                  'Nachname   Vorname    Passwort   Pers-Nr.   Benutzer 
43.
    End If 
44.
     
45.
    If oUserCon.State Then oUserCon.Close 
46.
     
47.
    Call WriteLogFile(LogFile) 
48.
 
49.
    MsgBox "Fertig!", vbInformation, "Hinweis...": 
50.
 
51.
'Main End
Quelltext | Drucken
01.
'Diese Function Liest die User-Daten aus dem ADS in einen Recordset (ungetestet) 
02.
 
03.
Private Function OpenUserRec() 
04.
    Dim oUserCom 
05.
     
06.
    On Error Resume Next 
07.
     
08.
    Set oUserCon = CreateObject("ADODB.Connection") 
09.
    Set oUserCom = CreateObject("ADODB.Command") 
10.
     
11.
    oUserCon.Provider = "ADsDSOObject" 
12.
    oUserCon.Open "Active Directory Provider" 
13.
     
14.
    Set oUserCom.ActiveConnection = oUserCon 
15.
     
16.
    oUserCom.Properties("Page Size") = 1000 
17.
    oUserCom.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
18.
     
19.
    '#########Entsprechend anpassen 
20.
    oUserCom.CommandText = "SELECT * FROM 'LDAP://DC=Test,DC=DOMAIN,DC=DE' WHERE ObjectCategory='user'" 
21.
         
22.
    Set oUserRec = oUserCom.Execute 
23.
     
24.
    If Err Then 
25.
        OpenUserRec = False         
26.
        If oUserCon.State Then oUserCon.Close 
27.
    Else 
28.
        OpenUserRec = True 
29.
        iCountADS1 = oUserRec.RecordCount:  iCountADS2 = iCountADS1  
30.
    End If 
31.
End Function
Quelltext | Drucken
01.
'Diese Funktion liest die User-Excel-Datei aus und füllt das Array oUserList mit neuen Usern. 
02.
'UserList(Values):  Nachname;Vorname;Passwort;Pers-Nr;Benutzername 
03.
'Die Spalte Benutzernamen hat dabei keine Relevanz, sie wird nur zu Infozwecken mit abgeglichen. 
04.
 
05.
Private Function GetUserDaten() 
06.
    Dim oExcelApp, oExcelSheet, aToken, sKey, sItem, sBenutzer, i 
07.
     
08.
    GetUserDaten = False 
09.
     
10.
    On Error Resume Next 
11.
     
12.
    Set oExcelApp = CreateObject("Excel.Application") 
13.
     
14.
    With oExcelApp.Workbooks.Open(ExcelFile) 
15.
        If Err Then oExcelApp.Quit:  Exit Function 
16.
 
17.
        On Error Goto 0 
18.
         
19.
        With .Sheets(1) 
20.
            For i = ExcelStart To .Cells(.Rows.Count, "A").End(xlUp).Row 
21.
                If .Cells(i, 1).Text <> "" Then 
22.
                    iCountExcel = iCountExcel + 1 
23.
                    
24.
                   '1:Nachname,2:Vorname,3:Passwort,4:Pers-Nr. 
25.
                    aToken = .Cells(i, 1).Resize(1, 4).Value 
26.
                     
27.
                    sBenutzer = GetAccountName(aToken(1, 2), aToken(1, 1)) 
28.
                     
29.
                   .Cells(i, 5) = sBenutzer 
30.
                     
31.
                    If sBenutzer = "" Then 
32.
                            Call SetLogMsg(aToken(1, 2), aToken(1, 1), "") 
33.
                            Call SetLogErr(LogErr1) 
34.
                    ElseIf TestAccountName(sBenutzer) = False Then 
35.
                        sItem = Array(aToken(1, 1), aToken(1, 2), aToken(1, 3), aToken(1, 4), sBenutzer) 
36.
                        oUserList.Add "$" & oUserList.Count + 1, Join(sItem, ";") 
37.
                    End If 
38.
                End If 
39.
            Next 
40.
        End With 
41.
       .Save 
42.
       .Close False 
43.
    End With 
44.
 
45.
    oExcelApp.Quit:  GetUserDaten = True 
46.
End Function
Quelltext | Drucken
01.
'Mit dieser Funktion werden dem AD neue User hinzugefügt (ungetestet) 
02.
'Der File-Server wird anhand des 1. Buchstabens des Benutzernamens zugeordent. 
03.
 
04.
Private Sub CreateNewUser(ByRef sNachname, ByRef sVorname, ByRef sPasswort, ByRef sPersNr, sBenutzer) 
05.
    Dim oOU, sFileServer, sCmd1, sCmd2, sErrMsg, iResult, i 
06.
     
07.
    On Error Resume Next 
08.
     
09.
    Select Case LCase(Left(sBenutzer, 1)) 
10.
        Case "a", "b", "c", "d", "e" 
11.
            sFileServer = "HomeDirSrv01" 
12.
        Case "f", "g", "h", "i", "j" 
13.
            sFileServer = "HomeDirSrv02" 
14.
        Case "k", "l", "m", "n", "o", "p", "q", "r" 
15.
            sFileServer = "HomeDirSrv03" 
16.
        Case Else 
17.
            sFileServer = "HomeDirSrv04" 
18.
    End Select 
19.
     
20.
    Call SetLogMsg(sVorname, sNachname, sBenutzer) 
21.
    
22.
    '#########Entsprechend anpassen 
23.
    Set oOU = GetObject("LDAP://OU=Test,DC=DOMAIN,DC=DE") 
24.
         
25.
    With oOU.Create("user", "CN=" & sBenutzer) 
26.
        .Put "sAMAccountName", sBenutzer 
27.
        .Put "givenName", sVorname 
28.
        .Put "sn", sNachname 
29.
        .Put "displayName", sNachname & " " & sVorname 
30.
        .Put "profilePath", "\\Server1\Profiles$\" & sBenutzer 
31.
        .Put "homeDirectory", "\\" & sFileServer & "\Homedirectory$\" & sBenutzer 
32.
        .Put "homeDrive", "P:" 
33.
        .Put "employeeID", sPersNr 
34.
        .Put "scriptPath", "login.bat" 
35.
        .SetInfo 
36.
        .SetPassword sPasswort 
37.
        .AccountDisabled = False 
38.
        .SetInfo 
39.
    End With 
40.
         
41.
    If Err Then Call SetLogErr(LogErr2):  Exit Sub 
42.
     
43.
    iCountADS2 = iCountADS2 + 1 
44.
     
45.
    WScript.Sleep (1000)    '??? 
46.
         
47.
    With CreateObject("Scripting.FilesystemObject") 
48.
        .CreateFolder ("\\" & sFileServer & "\HomeDirectory\" & sBenutzer) 
49.
        .CreateFolder ("\\Server02\Profiles\" & sBenutzer) 
50.
    End With 
51.
         
52.
    If Err Then Call SetLogErr(LogErr3):  Exit Sub 
53.
     
54.
    sCmd1 = "cacls ""\\" & sFileServer & "\HomeDirectory\" & sBenutzer & """ /t /e /c /g " & _ 
55.
            "Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C" 
56.
         
57.
    sCmd2 = "cacls ""\\Server02\Profiles\" & sBenutzer & """ /t /e /c /g " & _ 
58.
            "Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C" 
59.
 
60.
    With CreateObject("WScript.Shell") 
61.
        If .Run(sCmd1, 0, True) Then Err.Raise -1 
62.
        If .Run(sCmd2, 0, True) Then Err.Raise -1 
63.
    End With 
64.
     
65.
    If Err Then Call SetLogErr(LogErr4) 
66.
 End Sub
Quelltext | Drucken
01.
'Diese Funktion prüft, ob der Benutzername im ADS existiert. Rückgabe: True/False 
02.
 
03.
Private Function TestAccountName(ByRef sBenutzer) 
04.
    TestAccountName = False 
05.
     
06.
    With oUserRec 
07.
        If sBenutzer <> "" And .EOF = False Then 
08.
            .MoveFirst 
09.
            .Find = "sAMAccountName = '" & sBenutzer & "'" 
10.
             If Not .EOF Then TestAccountName = True 
11.
        End If 
12.
    End With 
13.
End Function
Quelltext | Drucken
01.
'Diese Funktion gibt den Benutzernamen des User's aus dem ADS zurück oder erstellt einen neuen 
02.
'Benutzernamen unter Berücksichtigung folgender Kriterien: 
03.
 
04.
'Umlaute werden ersetzt z.B. 'ü' durch 'ue'... 
05.
'Der Benutzername hat eine maximale Länge, die durch die Konstante 'AccountLength' definiert ist. 
06.
'Der Nachname hat dabei eine maximale Länge von AccountLength -1 und der Vorname eine Länge von 1. 
07.
'Existiert ein Benutzername bereits, dann wird dem Nachnamen eine Ziffern zwischen 1-9 angefügt. 
08.
'Beispiele mit den Namen: 'Müller Anton', Müller Andrea', 'Dorn Beni', 'Müller Anton', 'Dorn Boris' 
09.
'Ergebnis: 'MuelleA', 'Muell1A', 'DornB', 'Muell2A', 'Dorn1B' 
10.
 
11.
Private Function GetAccountName(ByRef sVorname, ByRef sNachname) 
12.
    Dim aUml, sBenutzer, sV, sN, i 
13.
     
14.
    sBenutzer = "" 
15.
     
16.
    With oUserRec 
17.
        If sVorname <> "" And sNachname <> "" And .EOF = False Then 
18.
           .Sort = "SN" 
19.
           .MoveFirst 
20.
            Do Until .EOF 
21.
           .Find = "SN = '" & sNachname & "'" 
22.
                If Not .EOF Then 
23.
                    If LCase(.Fields("GivenName")) = LCase(sVorname) Then 
24.
                        sBenutzer = .Fields("sAMAccountName"): Exit Do 
25.
                    End If 
26.
                   .MoveNext 
27.
                End If 
28.
            Loop 
29.
        End If 
30.
    End With 
31.
 
32.
    If sBenutzer = "" Then 
33.
        aUml = Array("ä", "ae", "Ä", "Ae", "ö", "oe", "Ö", "Oe", "ü", "ue", "Ü", "Ue") 
34.
     
35.
        sV = sVorname:   sN = sNachname 
36.
         
37.
        For i = 0 To UBound(aUml) Step 2 
38.
            sV = Replace(sV, aUml(i), aUml(i + 1)) 
39.
            sN = Replace(sN, aUml(i), aUml(i + 1)) 
40.
        Next 
41.
         
42.
        sV = Left(sV, 1):  sN = Left(sN, AccountLength - 1):  sBenutzer = sN & sV 
43.
         
44.
        If TestAccountName(sBenutzer) Then 
45.
            For i = 1 To 9 
46.
                sBenutzer = Left(sN, AccountLength - 2) & i & sV 
47.
                If TestAccountName(sBenutzer) Then sBenutzer = "" Else Exit For 
48.
            Next 
49.
        End If 
50.
    End If 
51.
         
52.
    GetAccountName = sBenutzer 
53.
End Function
Quelltext | Drucken
01.
'Diese Funktion fügt dem Log-Text eine Zeile mit dem Usernamen... hinzu 
02.
 
03.
Private Sub SetLogMsg(ByRef sMsg1, sMsg2, sMsg3) 
04.
    sLogMsg = sLogMsg & vbCrLf & "User:  " & sMsg1 & ", " & sMsg2 & ", " & sMsg3 & vbCrLf 
05.
End Sub
Quelltext | Drucken
01.
'Diese Funktion fügt dem Log-Text eine Zeile mit einer Fehlermeldung hinzu 
02.
 
03.
Private Sub SetLogErr(ByRef sErr) 
04.
    sLogMsg = sLogMsg & Space(13) & sErr & " fehlgeschlagen...  " & vbCrLf 
05.
End Sub
Quelltext | Drucken
01.
'Diese Funktion schreibt den Log-Text in die Log-Datei (LogFile) 
02.
 
03.
Private Sub WriteLogFile(ByRef sFile) 
04.
    Dim oFso, sHead 
05.
     
06.
    sHead = vbCrLf & "Erstellt am:" & Space(12) & Now & vbCrLf & vbCrLf & vbCrLf & "User Gesamt:" _ 
07.
                   & Space(8) & "ADS davor:  " & iCountADS1 & Space(8) & "ADS danach:  " _ 
08.
                   & iCountADS2 & Space(8) & "Excel-Datei:  " & iCountExcel & vbCrLf & vbCrLf 
09.
     
10.
    Set oFso = CreateObject("Scripting.FileSystemObject") 
11.
     
12.
    With oFso.CreateTextFile(sFile) 
13.
        .Write sHead & sLogMsg 
14.
        .Close 
15.
    End With 
16.
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]
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
19.07.2012 um 08:36 Uhr
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 (Level 3)
19.07.2012 um 10:14 Uhr
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 (Level 3)
19.07.2012 um 10:39 Uhr
Hallo Wladislaw!

Im Code 'Private Function OpenUserRec' habe ich was vergessen einzufügen. Ersetzte diesen Codeteil
Quelltext | Drucken
01.
    If Err Then 
02.
        If oUserCon.State Then oUserCon.Close 
03.
        OpenUserRec = False 
04.
    Else 
05.
        OpenUserRec = True 
06.
    End If
durch diesen Codeteil
Quelltext | Drucken
01.
    If Err Then 
02.
        If oUserCon.State Then oUserCon.Close 
03.
        OpenUserRec = False 
04.
    Else 
05.
        iCountADS1 = oUserRec.RecordCount:  iCountADS2 = iCountADS1 
06.
        OpenUserRec = True 
07.
    End If
Gruß Dieter
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
19.07.2012 um 11:28 Uhr
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 (Level 3)
19.07.2012, aktualisiert um 15:34 Uhr
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
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
19.07.2012 um 14:57 Uhr
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 (Level 3)
19.07.2012, aktualisiert um 15:51 Uhr
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 wird

Gruß Dieter

[edit] Codezeile enthielt einen Fehler (korrigiert) [/edit]
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
19.07.2012 um 17:08 Uhr
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 (Level 3)
19.07.2012, aktualisiert um 19:15 Uhr
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 sehen

Gruß Dieter


PS. Im Quellcode mit 'Private Function GetUserDaten' die Codezeile 39 eingefügt und Codezeile 40 geändert in:
Quelltext | Drucken
01.
 .Save 
02.
 .Close False
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
19.07.2012 um 22:08 Uhr
Hallo Dieter,

kann ich dir irgendwie einen screenshot senden?

Gruß Wladislaw
Mitglied: bastla
bastla (Level 5) - Jetzt verbinden
19.07.2012, aktualisiert um 22:30 Uhr
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 (Level 3)
19.07.2012, aktualisiert um 23:03 Uhr
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ützung

Gruß Dieter
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
20.07.2012 um 08:16 Uhr
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 (Level 3)
20.07.2012, aktualisiert um 10:53 Uhr
Hallo Zusammen!

Hab den Fehler gefunden

@wladislaw
Ersetze die komplette Function 'Private Function GetAccountName' durch diese:
Quelltext | Drucken
01.
Private Function GetAccountName(ByRef sVorname, ByRef sNachname) 
02.
    Dim aUml, sBenutzer, sV, sN, i 
03.
     
04.
    sBenutzer = "" 
05.
     
06.
    With oUserRec 
07.
        If sVorname <> "" And sNachname <> "" And .EOF = False Then 
08.
           .Sort = "SN" 
09.
           .MoveFirst 
10.
            Do Until .EOF 
11.
           .Find = "SN = '" & sNachname & "'" 
12.
                If Not .EOF Then 
13.
                    If LCase(.Fields("GivenName")) = LCase(sVorname) Then 
14.
                        sBenutzer = .Fields("sAMAccountName"): Exit Do 
15.
                    End If 
16.
                   .MoveNext 
17.
                End If 
18.
            Loop 
19.
        End If 
20.
    End With 
21.
 
22.
    If sBenutzer = "" Then 
23.
        aUml = Array("ä", "ae", "Ä", "Ae", "ö", "oe", "Ö", "Oe", "ü", "ue", "Ü", "Ue") 
24.
     
25.
        sV = sVorname:   sN = sNachname 
26.
         
27.
        For i = 0 To UBound(aUml) Step 2 
28.
            sV = Replace(sV, aUml(i), aUml(i + 1)) 
29.
            sN = Replace(sN, aUml(i), aUml(i + 1)) 
30.
        Next 
31.
         
32.
        sBenutzer = Left(Left(sN, AccountLength - 1) & sV, AccountLength) 
33.
         
34.
        If TestAccountName(sBenutzer) Then 
35.
            For i = 1 To 9 
36.
                sBenutzer = Left(Left(sN, AccountLength - 2) & i & sV, AccountLength) 
37.
                If TestAccountName(sBenutzer) Then sBenutzer = "" Else Exit For 
38.
            Next 
39.
        End If 
40.
    End If 
41.
         
42.
    GetAccountName = sBenutzer 
43.
End Function
Der Fehler entsteht wenn der AD-Recordset leer ist (EOF)

Und ersetze in der Function 'Private Function GetUserDaten' diese Codezeile:
Quelltext | Drucken
01.
        If Err Then oExcelApp.Quit:  Exit Function
durch diese Codezeilen
Quelltext | Drucken
01.
        If Err Then oExcelApp.Quit:  Exit Function 
02.
         
03.
        On Error GoTo 0
Ersetzte auch die Function 'TestAccountName' durch diese:
Quelltext | Drucken
01.
'Diese Funktion prüft, ob der Benutzername im ADS existiert. Rückgabe: True/False 
02.
 
03.
Private Function TestAccountName(ByRef sBenutzer) 
04.
    TestAccountName = False 
05.
     
06.
    With oUserRec 
07.
        If sBenutzer <> "" And .EOF = False Then 
08.
            .MoveFirst 
09.
            .Find = "sAMAccountName = '" & sBenutzer & "'" 
10.
             If Not .EOF Then TestAccountName = True 
11.
        End If 
12.
    End With 
13.
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
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
20.07.2012 um 15:26 Uhr
Hallo Dieter,

Super. Danke. Grundsätzlich funktioniert. !!!!!!!!!!!!


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
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
20.07.2012 um 15:43 Uhr
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 (Level 3)
20.07.2012, aktualisiert um 16:28 Uhr
Hallo Wladislaw!

Irgendwie blicke ich in diesem Durcheinander im Moment überhaupt nicht durch
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
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
21.07.2012 um 23:32 Uhr
Hallo Dieter,

Danke. es funktioniert.
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 (Level 3)
22.07.2012, aktualisiert um 10:09 Uhr
Hallo wladislaw!

Danke. es funktioniert...
Freut mich zu hören

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 Zeichen


Gruß Dieter
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
23.07.2012 um 10:38 Uhr
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 (Level 3)
25.07.2012, aktualisiert um 22:46 Uhr
Hallo Wladislaw!

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

Hoffe, die Benutzernamen werden jetzt richtig erstellt

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
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
26.07.2012 um 13:49 Uhr
Hallo Dieter,

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

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 (Level 3)
26.07.2012, aktualisiert um 15:46 Uhr
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 gedacht

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


Gruß Dieter
Mitglied: 76109
76109 (Level 3)
26.07.2012, aktualisiert 11.08.2012
Hallo Wladislaw!

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

Quelltext | Drucken
01.
Option Explicit 
02.
 
03.
Private Const ExcelFile = "E:\Test\User.xls" 
04.
Private Const ExcelStart = 2            'Zeile mit dem 1. Eintrag 
05.
 
06.
Private Const LogFile = "E:\Test\User.Log" 
07.
 
08.
Private Const AccountLength = 7         'Anzahl Zeichen für Benutzername 
09.
 
10.
Private Const xlUp = &HFFFFEFBE         'Konstante: Excel 
11.
Private Const ADS_SCOPE_SUBTREE = 2     'Konstante: ADO-Recordset 
12.
 
13.
Private Const MsgErr1 = "Datenimport vom ADS fehlgeschlagen!" 
14.
Private Const MsgErr2 = "Datemimport aus Excel-Datei fehlgeschlagen!" 
15.
 
16.
Private Const LogErr1 = "Benutzername erstellen" 
17.
Private Const LogErr2 = "User dem ADS hinzufügen" 
18.
Private Const LogErr3 = "HomeDir/Profile-Verzeichnis erstellen" 
19.
Private Const LogErr4 = "HomeDir/Profile-Berechtigungen erstellen" 
20.
 
21.
Private oUserList, oNewUserList, oUser, aDaten, sLogMsg, iCountADS1, iCountADS2, iCountExcel 
22.
 
23.
 
24.
'Main Beg 
25.
 
26.
    'Assoziatives Arrays für User-Daten 
27.
    Set oUserList = CreateObject("Scripting.Dictionary")    'User-Bestand 
28.
    Set oNewUserList = CreateObject("Scripting.Dictionary") 'User-Neu hinzufügen 
29.
     
30.
    'ADS-Daten einlesen 
31.
    If OpenUserRec = False Then 
32.
        MsgBox MsgErr1, vbExclamation, "Fehler...":  WScript.Quit 
33.
    End If 
34.
     
35.
    'Excel-Daten einlesen und neue User im ADS anlegen 
36.
    If GetUserDaten = False Then 
37.
        MsgBox MsgErr2, vbExclamation, "Fehler...":  WScript.Quit 
38.
    Else 
39.
        For Each oUser In oNewUserList.Items 
40.
            aDaten = Split(oUser, ";") 
41.
            Call CreateNewUser(aDaten(0), aDaten(1), aDaten(2), aDaten(3), aDaten(4)) 
42.
        Next                  'Nachname   Vorname    Passwort   Pers-Nr.   Benutzer 
43.
    End If 
44.
     
45.
    Call WriteLogFile(LogFile) 
46.
     
47.
    Set oUserList = Nothing 
48.
    Set oNewUserList = Nothing 
49.
 
50.
'Main End 
51.
 
52.
 
53.
'Diese Function Liest die User-Daten aus dem ADS in einen Recordset (ungetestet) 
54.
 
55.
Private Function OpenUserRec() 
56.
    Dim oUserCon, oUserCom, oUserRec 
57.
     
58.
    On Error Resume Next 
59.
     
60.
    Set oUserCon = CreateObject("ADODB.Connection") 
61.
    Set oUserCom = CreateObject("ADODB.Command") 
62.
     
63.
    oUserCon.Provider = "ADsDSOObject" 
64.
    oUserCon.Open "Active Directory Provider" 
65.
     
66.
    Set oUserCom.ActiveConnection = oUserCon 
67.
     
68.
    oUserCom.Properties("Page Size") = 1000 
69.
    oUserCom.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
70.
     
71.
    '#########Entsprechend anpassen 
72.
    oUserCom.CommandText = "SELECT * FROM 'LDAP://DC=Test,DC=DOMAIN,DC=DE' WHERE ObjectCategory='user'" 
73.
         
74.
    Set oUserRec = oUserCom.Execute 
75.
     
76.
    If Err Then 
77.
        OpenUserRec = False 
78.
    Else 
79.
        OpenUserRec = True 
80.
 
81.
        With oUserRec 
82.
            If .RecordCount Then 
83.
               .Sort = "sAMAccountName" 
84.
               .MoveFirst 
85.
                Do Until .EOF 
86.
                    oUserList.Add .Fields("sAMAccountName").Value, _ 
87.
                                  .Fields("SN").Value & ";" & .Fields("GivenName").Value 
88.
                   .MoveNext 
89.
                Loop 
90.
            End If 
91.
        End With 
92.
         
93.
        iCountADS1 = oUserList.Count:   iCountADS2 = iCountADS1 
94.
    End If 
95.
     
96.
    If oUserCon.State Then oUserRec.Close:  oUserCon.Close 
97.
End Function 
98.
 
99.
'Diese Funktion liest die User-Excel-Datei aus und füllt das Array oNewUserList mit neuen Usern. 
100.
'NewUserList(Values):  Nachname;Vorname;Passwort;Pers-Nr;Benutzername 
101.
'Die Spalte Benutzernamen hat dabei keine Relevanz, sie wird nur zu Infozwecken mit abgeglichen. 
102.
 
103.
Private Function GetUserDaten() 
104.
    Dim oExcelApp, oExcelSheet, aToken, sKey, sItem, sBenutzer, i 
105.
     
106.
    GetUserDaten = False 
107.
     
108.
    On Error Resume Next 
109.
     
110.
    Set oExcelApp = CreateObject("Excel.Application") 
111.
     
112.
    With oExcelApp.Workbooks.Open(ExcelFile) 
113.
        If Err Then oExcelApp.Quit:  Exit Function 
114.
         
115.
        On Error GoTo 0 
116.
         
117.
        With .Sheets(1) 
118.
            For i = ExcelStart To .Cells(.Rows.Count, "A").End(xlUp).Row 
119.
                If .Cells(i, 1).Text <> "" Then 
120.
                    iCountExcel = iCountExcel + 1 
121.
                    
122.
                   '1:Nachname,2:Vorname,3:Passwort,4:Pers-Nr. 
123.
                    aToken = .Cells(i, 1).Resize(1, 4).Value 
124.
                     
125.
                    sBenutzer = GetAccountName(aToken(1, 2), aToken(1, 1)) 
126.
                     
127.
                   .Cells(i, 5) = sBenutzer 
128.
                     
129.
                    If sBenutzer = "" Then 
130.
                            Call SetLogMsg(aToken(1, 2), aToken(1, 1), "") 
131.
                            Call SetLogErr(LogErr1) 
132.
                    ElseIf oUserList.Exists(sBenutzer) = False Then 
133.
                        sItem = Array(aToken(1, 1), aToken(1, 2), aToken(1, 3), aToken(1, 4), sBenutzer) 
134.
                        oNewUserList.Add "$" & oNewUserList.Count + 1, Join(sItem, ";") 
135.
                    End If 
136.
                End If 
137.
            Next 
138.
        End With 
139.
       .Save 
140.
       .Close False 
141.
    End With 
142.
 
143.
    oExcelApp.Quit:  GetUserDaten = True 
144.
End Function 
145.
 
146.
'Mit dieser Funktion werden dem AD neue User hinzugefügt (ungetestet) 
147.
'Der File-Server wird anhand des 1. Buchstabens des Benutzernamens zugeordent. 
148.
 
149.
Private Sub CreateNewUser(ByRef sNachname, ByRef sVorname, ByRef sPasswort, ByRef sPersNr, sBenutzer) 
150.
    Dim oOU, sFileServer, sCmd1, sCmd2, sErrMsg, iResult, i 
151.
     
152.
    On Error Resume Next 
153.
     
154.
    Select Case LCase(Left(sBenutzer, 1)) 
155.
        Case "a", "b", "c", "d", "e" 
156.
            sFileServer = "HomeDirSrv01" 
157.
        Case "f", "g", "h", "i", "j" 
158.
            sFileServer = "HomeDirSrv02" 
159.
        Case "k", "l", "m", "n", "o", "p", "q", "r" 
160.
            sFileServer = "HomeDirSrv03" 
161.
        Case Else 
162.
            sFileServer = "HomeDirSrv04" 
163.
    End Select 
164.
     
165.
    Call SetLogMsg(sVorname, sNachname, sBenutzer) 
166.
    
167.
    '#########Entsprechend anpassen 
168.
    Set oOU = GetObject("LDAP://OU=Test,DC=DOMAIN,DC=DE") 
169.
         
170.
    With oOU.Create("user", "CN=" & sBenutzer) 
171.
        .Put "sAMAccountName", sBenutzer 
172.
        .Put "givenName", sVorname 
173.
        .Put "sn", sNachname 
174.
        .Put "displayName", sNachname & " " & sVorname 
175.
        .Put "profilePath", "\\Server1\Profiles$\" & sBenutzer 
176.
        .Put "homeDirectory", "\\" & sFileServer & "\Homedirectory$\" & sBenutzer 
177.
        .Put "homeDrive", "P:" 
178.
        .Put "employeeID", sPersNr 
179.
        .Put "scriptPath", "login.bat" 
180.
        .SetInfo 
181.
        .SetPassword sPasswort 
182.
        .AccountDisabled = False 
183.
        .SetInfo 
184.
    End With 
185.
         
186.
    If Err Then  
187.
        Call SetLogErr(LogErr2):  Exit Sub 
188.
    Else 
189.
        oUserList.Add sBenutzer, sNachname & ";" & sVorname 
190.
    End If 
191.
     
192.
    iCountADS2 = iCountADS2 + 1 
193.
     
194.
    WScript.Sleep (1000) 
195.
         
196.
    With CreateObject("Scripting.FilesystemObject") 
197.
        .CreateFolder ("\\" & sFileServer & "\HomeDirectory\" & sBenutzer) 
198.
        .CreateFolder ("\\Server02\Profiles\" & sBenutzer) 
199.
    End With 
200.
         
201.
    If Err Then Call SetLogErr(LogErr3):  Exit Sub 
202.
     
203.
    sCmd1 = "cacls ""\\" & sFileServer & "\HomeDirectory\" & sBenutzer & """ /t /e /c /g " & _ 
204.
            "Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C" 
205.
         
206.
    sCmd2 = "cacls ""\\Server02\Profiles\" & sBenutzer & """ /t /e /c /g " & _ 
207.
            "Domain\Domänen-Admins:F Domain\" & sBenutzer & ":C" 
208.
 
209.
    With CreateObject("WScript.Shell") 
210.
        If .Run(sCmd1, 0, True) Then Err.Raise -1 
211.
        If .Run(sCmd2, 0, True) Then Err.Raise -1 
212.
    End With 
213.
     
214.
    If Err Then Call SetLogErr(LogErr4) 
215.
 End Sub 
216.
 
217.
 
218.
'Diese Funktion gibt den Benutzernamen des User's aus dem ADS zurück oder erstellt einen neuen 
219.
'Benutzernamen unter Berücksichtigung folgender Kriterien: 
220.
 
221.
'Umlaute werden ersetzt z.B. 'ü' durch 'ue'... 
222.
'Der Benutzername hat eine vorgegebene Länge, die durch die Konstante 'AccountLength' definiert ist. 
223.
'Im Idealfall besteht der Benutzername vom 1. bis zum 2. letzten Buchstaben aus dem Nachnamen und 
224.
'dem ersten Buchstaben des Vornamen. Ansonsten wird der 2. letzte Buchstabe durch eine Ziffern 1-9 
225.
'ersetzt. Bei kürzeren Nachnamen, wird die entsprechenden Anzahl mit dem Vornamen aufgerundet. 
226.
'Beispiele mit den Namen: 'Müller Anton', Müller Andrea', 'Dorn Peter', 'Müller Anton' 
227.
'Ergebnis: 'MuelleA', 'Muell1A', 'DornP', 'Muell2A' 
228.
 
229.
Private Function GetAccountName(ByRef sVorname, ByRef sNachname) 
230.
    Dim oUser, aUser, aUml, sBenutzer, sV, sN, i, x 
231.
     
232.
    sBenutzer = "" 
233.
     
234.
    For Each oUser In oUserList 
235.
        If LCase(oUserList(oUser)) = LCase(sNachname & ";" & sVorname) Then 
236.
            sBenutzer = oUser:  Exit For 
237.
        End If 
238.
    Next 
239.
 
240.
    If sBenutzer = "" Then 
241.
        aUml = Array("ä", "ae", "Ä", "Ae", "ö", "oe", "Ö", "Oe", "ü", "ue", "Ü", "Ue") 
242.
     
243.
        sV = sVorname:   sN = sNachname 
244.
         
245.
        For i = 0 To UBound(aUml) Step 2 
246.
            sV = Replace(sV, aUml(i), aUml(i + 1)) 
247.
            sN = Replace(sN, aUml(i), aUml(i + 1)) 
248.
        Next 
249.
         
250.
        sV = Left(sV, 1):  sN = Left(sN, AccountLength - 1):  sBenutzer = sN & sV 
251.
         
252.
        If oUserList.Exists(sBenutzer) Then 
253.
            For i = 1 To 9 
254.
                sBenutzer = Left(sN, AccountLength - 2) & i & sV 
255.
                If oUserList.Exists(sBenutzer) Then sBenutzer = "" Else Exit For 
256.
            Next 
257.
        End If 
258.
    End If 
259.
End Function 
260.
 
261.
'Diese Funktion fügt dem Log-Text eine Zeile mit dem Usernamen... hinzu 
262.
Private Sub SetLogMsg(ByRef sMsg1, sMsg2, sMsg3) 
263.
    sLogMsg = sLogMsg & vbCrLf & "User:  " & sMsg1 & ", " & sMsg2 & ", " & sMsg3 & vbCrLf 
264.
End Sub 
265.
 
266.
'Diese Funktion fügt dem Log-Text eine Zeile mit einer Fehlermeldung hinzu 
267.
Private Sub SetLogErr(ByRef sErr) 
268.
    sLogMsg = sLogMsg & Space(13) & sErr & " fehlgeschlagen...  " & vbCrLf 
269.
End Sub 
270.
 
271.
'Diese Funktion schreibt den Log-Text in die Log-Datei (LogFile) 
272.
Private Sub WriteLogFile(ByRef sFile) 
273.
    Dim oFso, sHead 
274.
     
275.
    sHead = vbCrLf & "Erstellt am:" & Space(12) & Now & vbCrLf & vbCrLf & vbCrLf & "User Gesamt:" _ 
276.
                   & Space(8) & "ADS davor:  " & iCountADS1 & Space(8) & "ADS danach:  " _ 
277.
                   & iCountADS2 & Space(8) & "Excel-Datei:  " & iCountExcel & vbCrLf & vbCrLf 
278.
     
279.
    Set oFso = CreateObject("Scripting.FileSystemObject") 
280.
     
281.
    With oFso.CreateTextFile(sFile) 
282.
        .Write sHead & sLogMsg 
283.
        .Close 
284.
    End With 
285.
End Sub
Gruß Dieter

[edit] Codezeile 115 noch eingefügt und einen Fehler korrigiert [/edit]
[edit] Copy/Paste-Fehler korrigiert [/edit]
Mitglied: wladislaw
wladislaw (Level 1) - Jetzt verbinden
06.08.2012 um 13:54 Uhr
Hallo Dieter,
Danke für dein neues Script , leider funktioniert es nicht

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 (Level 3)
08.08.2012 um 16:20 Uhr
Hallo Wladislaw!

Sorry, da hatte ich bei Copy/Paste doch Mist gebaut

Hab's im Quelltext entsprechend geändert


Gruß Dieter
Frage Entwicklung VB for Applications
Ähnliche Inhalte
Windows Userverwaltung

AD User wechsel Gruppe automatisch nach Datum

gelöst Frage von TutterWindows Userverwaltung4 Kommentare

Hallo an alle ich suche eine Möglichkeit eine User zu einem Stichtag automatisch die Gruppe wechseln zu lassen im ...

Batch & Shell

Erstellung von Sicherheitsgruppen AD, zuweisung von Usern und erstellung-entferung von Freigaben

Frage von shooanBatch & Shell9 Kommentare

Guten Morgen, ich habe ein etwas größeres Problem, das zwar konventionell gelöst werden kann, dies aber viel Klick Arbeit ...

Windows Userverwaltung

AD Gruppen User auslesen

Frage von pgWindows Userverwaltung1 Kommentar

Guten Tag, ich bin auf der Suche nach einem Programm welches mit die User eines AD ausliest und mir ...

Batch & Shell

AD User bearbeiten

gelöst Frage von complexBatch & Shell1 Kommentar

Hi mal wieder :) bin gerade an einem Script, welches vorhandene AD User mit Standardberechtigungen versieht und verschiedene Aktionen ...

Neue Wissensbeiträge
Humor (lol)
IoT-Gefahr: Smartes Aquarium leckt!
Information von Lochkartenstanzer vor 1 TagHumor (lol)3 Kommentare

Moin, Die IoT-Manie hat weitere Opfer gefunden. Ein Casino-Leck durch ein smartes Aquarium: Allerdings haben sie kein Wasser, sondern ...

Router & Routing

Alte Fritzbox 7270 mit VPN und SIP-Telefonie hinter O2 Homebox 6641 als "Modem"

Erfahrungsbericht von the-buccaneer vor 2 TagenRouter & Routing3 Kommentare

Nun war es soweit: Auch O2 hat mich mit VOIP zwangsbeglückt. Heute am Privatanschluss, in 2 Wochen ist das ...

Sicherheit

Ungepatchte Remote Code Execution-Lücke in LG NAS

Information von kgborn vor 2 TagenSicherheit

Nutzt wer LG NAS-Einheiten? In den NAS-Einheiten der LG Network Storage-Einheiten gibt es eine sehr unschöne Schwachstelle, die einen ...

Windows Update

Neue Version KB4099950 NIC Einstellungen gehen verloren

Information von sabines vor 2 TagenWindows Update2 Kommentare

Es ist eine neue Version des KB4099950 verfügbar, die das Problem mit den verlorenen Netzwerkeinstellungen lösen soll. Das Datum ...

Heiß diskutierte Inhalte
Linux Netzwerk
Raspberry Pi 3: WLAN Power save deaktivieren
Frage von nordie92Linux Netzwerk14 Kommentare

Moin moin, mein Raspberry Pi 3 Model B benötigt eine dauerhaft aktive WLAN-Verbindung. Leider bricht die WLAN-Verbindung nach einigen ...

Netzwerkmanagement
Netzwerkmanagment im Haus mit Switch, Panel und pfsense
gelöst Frage von CorraggiounoNetzwerkmanagement13 Kommentare

hi zusammen, wir sind gerade dabei das ganze Haus bzw. die einzelnen Zimmer mit netzwerkdosen zu versorgen. Vom Keller ...

Vmware
Server 2008 r2 vmware terminalserver
Frage von MasterCVmware12 Kommentare

Guten Abend zusammen, ich hoffe , dass einer von euch mir weiterhelfen kann ,bei meinem kack Problem ! Ist ...

Google Android
Empfehlung: Android Ortungsapp
gelöst Frage von certifiedit.netGoogle Android12 Kommentare

Guten Morgen, grundsätzlich vorweg, ich wollte mich eben schlau machen, bzgl einer Ortungsapp, welche Androidbasiert einem anderen Androidsmartphone mitteilt, ...

AixitICO