codice:
Option Explicit
Dim objExcel, strExcelPath, objSheet
Dim strLast, strFirst, strMiddle, strPW, intRow, intCol
Dim strGroupDN, objUser, objGroup, objContainer
Dim strCN, strNTName, strContainerDN
Dim strHomeFolder, strHomeDrive, objFSO, objShell, strHomeFolderProfile
Dim intRunError, strNetBIOSDomain, strDNSDomain
Dim objRootDSE, objTrans, strLogonScript, strUPN
' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
' Specify spreadsheet.
strExcelPath = "c:\Utenti\Utenti.xls"
' Specify DN of container where users created.
strContainerDN = "ou=Utenti, dc=FideFior"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
' Use the NameTranslate object to find the NetBIOS domain name
' from the DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
' Open spreadsheet.
Set objExcel = CreateObject("Excel.Application")
On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to open spreadsheet " & strExcelPath
Wscript.Quit
End If
On Error GoTo 0
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
' Bind to container where users to be created.
On Error Resume Next
Set objContainer = GetObject("LDAP://" & strContainerDN)
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to bind to container: " & strContainerDN
Wscript.Quit
End If
On Error GoTo 0
' Start with row 2 of spreadsheet.
' Assume first row has column headings.
intRow = 2
' Read each row of spreadsheet until a blank value
' encountered in column 5 (the column for cn).
' For each row, create user and set attribute values.
Do While objSheet.Cells(intRow, 5).Value <> ""
' Read values from spreadsheet for this user.
strFirst = Trim(objSheet.Cells(intRow, 1).Value)
strMiddle = Trim(objSheet.Cells(intRow, 2).Value)
strLast = Trim(objSheet.Cells(intRow, 3).Value)
strPW = Trim(objSheet.Cells(intRow, 4).Value)
strCN = Trim(objSheet.Cells(intRow, 5).Value)
strNTName = Trim(objSheet.Cells(intRow, 6).Value)
strUPN = Trim(objSheet.Cells(intRow, 7).Value)
strHomeFolder = Trim(objSheet.Cells(intRow, 8).Value)
strHomeDrive = Trim(objSheet.Cells(intRow, 9).Value)
strHomeFolderProfile = Trim(objSheet.Cells(intRow, 10).Value)
strLogonScript = Trim(objSheet.Cells(intRow, 11).Value)
' Create user object.
On Error Resume Next
Set objUser = objContainer.Create("user", "cn=" & strCN)
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to create user with cn: " & strCN
Else
On Error GoTo 0
' Assign mandatory attributes and save user object.
If strNTName = "" Then
strNTName = strCN
End If
objUser.sAMAccountName = strNTName
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to create user with NT name: " & strNTName
Else
' Set password for user.
objUser.SetPassword strPW
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set password for user " & strNTName
End If
On Error GoTo 0
' Enable the user account.
objUser.AccountDisabled = False
If strFirst <> "" Then
objUser.givenName = strFirst
End If
' Assign values to remaining attributes.
If strMiddle <> "" Then
objUser.initials = strMiddle
End If
If strLast <> "" Then
objUser.sn = strLast
End If
If strUPN <> "" Then
objUser.userPrincipalName = strUPN
End If
If strHomeFolder <> "" Then
objUser.TerminalServicesHomeDirectory = strHomeFolder
End If
If strHomeFolderProfile <> "" Then
objUser.TerminalServicesProfilePath = strHomeFolderProfile
End If
If strLogonScript <> "" Then
objUser.scriptPath = strLogonScript
End If
' Set password expired. Must be changed on next logon.
objUser.pwdLastSet = 0
' Save changes.
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set attributes for user with NT name: " _
& strNTName
End If
On Error GoTo 0
' Create home folder.
If strHomeFolder <> "" Then
If Not objFSO.FolderExists(strHomeFolder) Then
On Error Resume Next
objFSO.CreateFolder strHomeFolder
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to create home folder: " & strHomeFolder
End If
On Error GoTo 0
End If
If objFSO.FolderExists(strHomeFolder) Then
' Assign user permission to home folder.
intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls " _
& strHomeFolder & " /T /E /C /G " & strNetBIOSDomain _
& "\" & strNTName & ":F", 2, True)
If intRunError <> 0 Then
Wscript.Echo "Error assigning permissions for user " _
& strNTName & " to home folder " & strHomeFolder
End If
End If
End If
' Create home folder Profile
If strHomeFolderProfile <> "" Then
If Not objFSO.FolderExists(strHomeFolder) Then
On Error Resume Next
objFSO.CreateFolder strHomeFolderProfile
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to create home folder Profile: " & strHomeFolderProfile
End If
On Error GoTo 0
End If
End If
' Group DN's start in column 11.
intCol = 11
Do While objSheet.Cells(intRow, intCol).Value <> ""
strGroupDN = Trim(objSheet.Cells(intRow, intCol).Value)
On Error Resume Next
Set objGroup = GetObject("LDAP://" & strGroupDN)
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to bind to group " & strGroupDN
Else
objGroup.Add objUser.AdsPath
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to add user " & strNTName _
& " to group " & strGroupDN
End If
End If
On Error GoTo 0
' Increment to next group DN.
intCol = intCol + 1
Loop
End If
End If
' Increment to next user.
intRow = intRow + 1
Loop
Wscript.Echo "Done"
' Clean up.
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
Set objUser = Nothing
Set objGroup = Nothing
Set objContainer = Nothing
Set objSheet = Nothing
Set objExcel = Nothing
Set objFSO = Nothing
Set objShell = Nothing
Set objTrans = Nothing
Set objRootDSE = Nothing
Rispondi quotando