Prøv dette script.
Scriptet opretter brugernavne udfra første bogstav i Fornavn + Mellemnavn + Efternavn.
Anders And bliver til AA
Rip And bliver til RA
Rap And bliver til RA1, da RA jo er brugt af Rip And
Rup And bliver til RA2
Fedtmule Han Hund bliver til FHH
Scriptet generer password på x længde, dog mindst 4 tegn.
Log på en maskine med en konto der har administrative rettighedder på domænet.
Opret et nyt Excel dokument eller rediger et eksisterende dokument.
Indtast disse overskrifter:
A1 = Brugernavn
B1 = Mellemnavn
C1 = Efternavn
D1 = Brugernavn
E1 = Password
Indtast bruger data i:
A2, B2, C2
A3, B3, C3
Og så videre.
Gem dokumentet som: C:\OpretBrugere\User.xls
Ret Const LDAPDomain = "dc=Dit_Domæne,dc=dk" til dine data
Ret Const Domain = "Dit_Domæne.dk" til dine data
Kopier teksten mellem, Script Start og Script Slut.
Gem den som C:\OpretBrugere\User.vbs
Hvis du bruger Notesblok så sæt sto og navn i gåseøjne "C:\OpretBrugere\User.vbs" da den ellers gemmes som C:\OpretBrugere\User.vbs.txt
Dobbelt klik på filen User.vbs
Når scriptet er færdig med at oprette brugere kan du gemme User.xls under et andet navn. Så har du en Exel fil med brugernavne og passwords. Den kan du bruge til at brevflette i Word.
:-)
'Script Start
'****** RET TIL AKTUELLE DATA *********************************************************************************************
Const LDAPDomain = "dc=Dit_Domæne,dc=dk" 'Domænenavn i LDAP format. dc=Dit_Domæne,dc=dk eller dc=Dit_Domæne,dc=local
Const Domain = "Dit_Domæne.dk" 'Domænenavn. Dit_Domæne.dk eller Dit_Domæne.local
Const ExcelName = "C:\OpretBrugere\User.xls" 'Sti til Exel dokument
Const PasswordLen = 7 'Længde på password
Const PwUpper = True 'Password skal indeholde store bogstaver
Const PwLower = True 'Password skal indeholde små bogstaver
Const PwNumber = True 'Password skal indeholde tal
Const PwSpecial = True 'Password skal indeholde specialtegn
'****** Disse data bruges til password, fjern dem du ikke vil have i et password. Du må ikke fjerne " *********************
Const strUpper = "ABCDEFGHIJKMNPQRSTUVWXYZ" 'Store bogstaver, L og O er ikke med, de kan nemt forveksles med 1 og 0
Const strLower = "abcdefghijkmnpqrstuvwxyz" 'Små bogstaver, l og o er ikke med, de kan nemt forveksles med 1 og 0
Const strNumber = "123456789" 'Tal, 0 er ikke med, kan nemt forveksles med O
Const strSpecial = "%&+-" 'Special tegn
'**************************************************************************************************************************
'****** RET IKKE NOGET HER UNDER ******************************************************************************************
'**************************************************************************************************************************
Const Fornavn = 1 'Kolonne 1 i Exel dokumentet. Fornavn, indskrives inden scriptet køres.
Const Mellemnavn = 2 'Kolonne 2 i Exel dokumentet. Mellemnavn, indskrives inden scriptet køres.
Const Efternavn = 3 'Kolonne 3 i Exel dokumentet. Efternavn, indskrives inden scriptet køres.
Const Brugernavn = 4 'Kolonne 4 i Exel dokumentet. Brugernavn, generes af scriptet
Const Password = 5 'Kolonne 5 i Exel dokumentet. Password, generes af scriptet
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
'**************************************************************************************************************************
'****** BRUGER OPRETTELSE *************************************************************************************************
'**************************************************************************************************************************
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(ExcelName)
objExcel.Visible = True
intRow = 2
Do Until objExcel.Cells(intRow, Fornavn).Value = ""
strInitialer = Ucase(Left(objExcel.Cells(intRow, Fornavn).Value, 1) & Left(objExcel.Cells(intRow, Mellemnavn).Value, 1) & Left(objExcel.Cells(intRow, Efternavn).Value, 1))
strFuldeNavn = objExcel.Cells(intRow, Fornavn).Value
If Len(objExcel.Cells(intRow, Mellemnavn).Value) > 0 Then
strFuldeNavn = strFuldeNavn & " " & objExcel.Cells(intRow, Mellemnavn).Value
End If
strFuldeNavn = strFuldeNavn &" " & objExcel.Cells(intRow, Efternavn).Value
strBrugerNavn = CreateUserName(strInitialer)
strPassword = GeneratePassword(PasswordLen, PwUpper, PwLower, PwNumber, PwSpecial)
Set objOU = GetObject("
LDAP://CN=Users," & LDAPDomain)
Set objUser = objOU.Create("User", "cn=" & strBrugerNavn)
objUser.Put "sAMAccountName", strBrugerNavn
objUser.SetInfo
objUser.AccountDisabled = FALSE
objUser.SetPassword strPassword
objUser.Put "userPrincipalName", strBrugerNavn & "@" & Domain
objUser.Put "givenName", objExcel.Cells(intRow, Fornavn).Value
objUser.Put "sn", objExcel.Cells(intRow, EfterNavn).Value
objUser.Put "initials", strInitialer
objUser.Put "DisplayName", strFuldeNavn
objUser.SetInfo
objUser.Put "userAccountControl", (objUser.Get("userAccountControl") Or ADS_UF_DONT_EXPIRE_PASSWD)
objUser.SetInfo
Call UserCannotChangePassword(objUser)
objExcel.Cells(intRow, Password).Value = strPassword
objExcel.Cells(intRow, Brugernavn).Value = strBrugerNavn
intRow = intRow + 1
Loop
'**************************************************************************************************************************
'****** DIVERSE FUNKTIONER OG RUTINER *************************************************************************************
'**************************************************************************************************************************
Function CreateUserName(samAccountName)
strUserName = samAccountName
Number = 1
While UserExist(strUserName)
strUserName = samAccountName & CStr(Number)
Number = Number + 1
Wend
CreateUserName = strUserName
End Function
'**************************************************************************************************************************
Function UserExist(samAccountName)
strUserName = samAccountName
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<
LDAP://" & LDAPDomain & ">;(&(objectCategory=User)(samAccountName=" & strUserName & "));samAccountName;subtree"
Set objRecordSet = objCommand.Execute
UserExist = objRecordset.RecordCount > 0
End Function
'**************************************************************************************************************************
Function GeneratePassword(strLength, U, L, N, S)
MinLength = 0
If U Then
MinLength = MinLength +1
End If
If L Then
MinLength = MinLength +1
End If
If N Then
MinLength = MinLength +1
End If
If S Then
MinLength = MinLength +1
End If
If strLength < MinLength Then
strLength = MinLength
End If
GeneratePassword = ""
For I = 1 to strLength
If I + MinLength => strLength Then
If U And Len(strUpper) > 0 And TestU(GeneratePassword) = 0 Then
strSeed = strUpper
ElseIf L And Len(strLower) > 0 And TestL(GeneratePassword) = 0 Then
strSeed = strLower
ElseIf N And Len(strNumber) > 0 And TestN(GeneratePassword) = 0 Then
strSeed = strNumber
ElseIf S And Len(strSpecial) > 0 And TestS(GeneratePassword) = 0 Then
strSeed = strSpecial
End If
Else
strSeed = strUpper + strLower + strNumber + strSpecial
End If
MFactor = Len(strSeed)
strNum = GenIt(MFactor)
strNext = Mid(strSeed, strNum, 1)
GeneratePassword = GeneratePassword & ChkNext(strNext, GeneratePassword, strSeed)
Next
End Function
'**************************************************************************************************************************
Function GenIt(MFactor)
Randomize
GenIt = INT(RND()*MFactor)+1
end Function
'**************************************************************************************************************************
Function ChkNext(strNext, GeneratePassword, strSeed)
strTmp = strNext
MFactor = Len(strSeed)
If InStr(1, GeneratePassword, strNext, 1) <>0 Then
strNum = GenIt(MFactor)
strNext = Mid(strSeed, strNum, 1)
strTmp = ChkNext(strNext, GeneratePassword, strSeed)
End if
ChkNext = strTmp
End Function
'**************************************************************************************************************************
Function TestN(Password)
TestN = 0
For I = 1 To Len(Password)
If Instr(strNumber, Mid(Password, I, 1)) >0 Then
TestN = TestN + 1
End If
Next
End Function
'**************************************************************************************************************************
Function TestU(Password)
TestU = 0
For I = 1 To Len(Password)
If Instr(strUpper, Mid(Password, I, 1)) >0 Then
TestU = TestU + 1
End If
Next
End Function
'**************************************************************************************************************************
Function TestL(Password)
TestL = 0
For I = 1 To Len(Password)
If Instr(strLower, Mid(Password, I, 1)) >0 Then
TestL = TestL + 1
End If
Next
End Function
'**************************************************************************************************************************
Function TestS(Password)
TestS = 0
For I = 1 To Len(Password)
If Instr(strSpecial, Mid(Password, I, 1)) >0 Then
TestS = TestS + 1
End If
Next
End Function
'**************************************************************************************************************************
Sub UserCannotChangePassword(oUserObject)
Dim oSecDescriptor
Dim oDACL
Dim oACE
Dim oACE2
Const CHANGE_PASSWORD_GUID = "{ab721a53-1e2f-11d0-9819-00aa0040529b}"
Set oACE = CreateObject("AccessControlEntry")
Set oACE2 = CreateObject("AccessControlEntry")
oACE.Trustee = "NT AUTHORITY\SELF"
oACE.AceFlags = 0
oACE.AceType = 6
oACE.Flags = 1
oACE.ObjectType = CHANGE_PASSWORD_GUID
oACE.AccessMask = 256
oACE2.Trustee = "EVERYONE"
oACE2.AceFlags = 0
oACE2.AceType = 6
oACE2.Flags = 1
oACE2.ObjectType = CHANGE_PASSWORD_GUID
oACE2.AccessMask = 256
Set oSecDescriptor = oUserObject.Get("ntSecurityDescriptor")
Set oDACL = oSecDescriptor.DiscretionaryAcl
oDACL.AddAce oACE
oDACL.AddAce oACE2
oUserObject.Put "ntSecurityDescriptor", oSecDescriptor
oUserObject.SetInfo
Set oACE = Nothing
Set oACE2 = Nothing
Set oDACL = Nothing
Set oSecDescriptor = Nothing
End Sub
'**************************************************************************************************************************
'Script Slut
Slettet bruger
Ny bruger
Nybegynder
Opret
Preview
