Modify Home Drive & Folder for all Users in an OU
Hello Experts,
First of all I would like to say I LOVE THIS SITE! You experts have been so helpful. The posts on this site have made my life SO mush easier. So Thanks!
Now that I have you all buttered up, moveing on to my Question.
I need the ability to Modify Home Drive & Folder for all Users in an OU. I have downloaded and modified the code at http://www.rlmueller.net/CreateUsers.htm to create new Users. I would like something simalar that will modify User attributes such as Home drive & home folder by reading from a spreadsheet. Any suggestions?
First of all I would like to say I LOVE THIS SITE! You experts have been so helpful. The posts on this site have made my life SO mush easier. So Thanks!
Now that I have you all buttered up, moveing on to my Question.
I need the ability to Modify Home Drive & Folder for all Users in an OU. I have downloaded and modified the code at http://www.rlmueller.net/CreateUsers.htm to create new Users. I would like something simalar that will modify User attributes such as Home drive & home folder by reading from a spreadsheet. Any suggestions?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Jared Luker
So you will need to change line 21, 37, and 39 at a minimum.
ASKER
Thanks, I will give this a try and get back to you.
ASKER
I have been unable to make this script do what I need for it to accomplish. I am Including the script I am useing to create my users along with a sample spreadsheet. Currently if this script finds that a user in the spreadsheet already exists it skips to the next user in the spreadsheet. Can someone please help me modify this script so that instead of skipping existing users it will modify there attributes (homeDrive, homeDirectory, etc...) according to the spreadsheet.
Thanks
Thanks
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
Dim intRunError, strNetBIOSDomain, strDNSDomain
Dim objRootDSE, objTrans, strLogonScript, strUPN
Dim strPreviousDN, blnBound
Dim strSchool, strType, strGrade
Dim strUserType, strDept, strDescription
' 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:\Test\NewUsers.xls"
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)
' 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 12 (the column for NTName).
' For each row, create user and set attribute values.
strPreviousDN = ""
Do While objSheet.Cells(intRow, 12).Value <> ""
' Read values from spreadsheet for this user.
strSchool = Trim(objSheet.Cells(intRow, 1).Value)
strGrade = Trim(objSheet.Cells(intRow, 2).Value)
strType = Trim(objSheet.Cells(intRow, 3).Value)
strUserType = Trim(objSheet.Cells(intRow, 4).Value)
strDept = Trim(objSheet.Cells(intRow, 5).Value)
strDescription = Trim(objSheet.Cells(intRow, 6).Value)
strFirst = Trim(objSheet.Cells(intRow, 7).Value)
strMiddle = Trim(objSheet.Cells(intRow, 8).Value)
strLast = Trim(objSheet.Cells(intRow, 9).Value)
strPW = Trim(objSheet.Cells(intRow, 10).Value)
strCN = Trim(objSheet.Cells(intRow, 11).Value)
strNTName = Trim(objSheet.Cells(intRow, 12).Value)
strUPN = Trim(objSheet.Cells(intRow, 13).Value)
strHomeFolder = Trim(objSheet.Cells(intRow, 14).Value)
strHomeDrive = Trim(objSheet.Cells(intRow, 15).Value)
strLogonScript = Trim(objSheet.Cells(intRow, 16).Value)
If strUserType = "Staff" And strDept = "Maintenacne" Then
strContainerDN = "ou=" & strDept & "," & "ou=" & strSchool & "," & "dc=stokes,dc=k12,dc=nc,dc=us"
Else
If strUserType = "Staff" And strDept = "AdminStaff" Then
strContainerDN = "ou=" & strDept & "," & "ou=" & strSchool & "," & "dc=stokes,dc=k12,dc=nc,dc=us"
Else
If strUserType = "Staff" And strDept = "Child Nutrition" Then
strContainerDN = "ou=" & strDept & "," & "ou=" & strSchool & "," & "dc=stokes,dc=k12,dc=nc,dc=us"
Else
If strUserType = "Staff" And strDept = "Execptional Children" Then
strContainerDN = "ou=" & strDept & "," & "ou=" & strSchool & "," & "dc=stokes,dc=k12,dc=nc,dc=us"
Else
If strUserType = "Staff" And strDept = "Bus Garage" Then
strContainerDN = "ou=" & strDept & "," & "ou=" & strSchool & "," & "dc=stokes,dc=k12,dc=nc,dc=us"
Else
If strUserType = "Staff" And strDept = "Teacher Coaches" Then
strContainerDN = "ou=" & strDept & "," & "ou=" & strSchool & "," & "dc=stokes,dc=k12,dc=nc,dc=us"
Else
If strUserType = "Staff" And strDept = "Nurses" Then
strContainerDN = "ou=" & strDept & "," & "ou=" & strSchool & "," & "dc=stokes,dc=k12,dc=nc,dc=us"
Else
If strUserType = "Staff" Then
strContainerDN = "ou=" & strSchool & "-" & strUserType & "," & "ou=" & strSchool & "," & "ou=" & strType & "," & "dc=stokes,dc=k12,dc=nc,dc=us"
Else
strContainerDN = "ou=" & strSchool & "-" & strGrade & "," & "ou=" & strSchool & "-" & strUserType & "," & "ou=" & strSchool & "," & "ou=" & strType & "," & "dc=stokes,dc=k12,dc=nc,dc=us"
End If
End If
End If
End If
End If
End If
End If
End If
'WScript.Echo strContainerDN
'WScript.Echo strUserType
' If this container is different from the previous, bind to
' the container the user object will be created in.
If (strContainerDN <> strPreviousDN) Then
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.Echo "Unable to create user with NT name: " & strNTName
' Flag that container not bound.
strPreviousDN = ""
Else
On Error GoTo 0
strPreviousDN = strContainerDN
End If
End If
' Proceed if parent container bound.
If (strPreviousDN <> "") Then
' 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 (strHomeDrive <> "") Then
objUser.homeDrive = strHomeDrive
End If
If (strHomeFolder <> "") Then
objUser.homeDirectory = strHomeFolder
End If
If (strLogonScript <> "") Then
objUser.scriptPath = strLogonScript
End If
If (strDescription <> "") Then
objUser.Description = strDescription
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 (objFSO.FolderExists(strHomeFolder) = False) 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 & "\" & strCN) = True) Then
' Assign user permission to home folder.
Dim command
If strUserType = "Staff" Then
command = "%COMSPEC% /c Echo Y| cacls " _
& Chr(34) & strHomeFolder & Chr(34) & " /T /C /P " _
& Chr(34) & strNetBIOSDomain & "\" & "Domain Admins" & Chr(34) & ":F " _
& strNetBIOSDomain & "\" & strSchool & "-NetAdmin:C " _
& strNetBIOSDomain & "\" & strNTName & ":C "
intRunError = objShell.Run(command, 2, True)
Else
End If
If strUserType = "Students" Then
command = "%COMSPEC% /c Echo Y| cacls " _
& Chr(34) & strHomeFolder & Chr(34) & " /T /C /P " _
& Chr(34) & strNetBIOSDomain & "\" & "Domain Admins" & Chr(34) & ":F " _
& strNetBIOSDomain & "\" & strSchool & "-NetAdmin:C " _
& strNetBIOSDomain & "\" & strSchool & "-Teachers:C " _
& strNetBIOSDomain & "\" & strNTName & ":C "
intRunError = objShell.Run(command, 2, True)
Else
End If
'WScript.Echo command
If (intRunError <> 0) Then
Wscript.Echo "Error assigning permissions for user " _
& strNTName & " to home folder " & strHomeFolder
End If
End If
End If
' Group DN's start in column 17.
intCol = 17
Do While objSheet.Cells(intRow, intCol).Value <> ""
strGroupDN = Trim(objSheet.Cells(intRow, intCol).Value)
' Attempt to bind to group object DN.
blnBound = False
'On Error Resume Next
'Set objGroup = GetObject("LDAP://" & strGroupDN)
'If (Err.Number <> 0) Then
'On Error GoTo 0
' Try again converting NT Name to DN.
On Error Resume Next
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain _
& "\" & strGroupDN
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to bind to group " & strGroupDN
Else
On Error GoTo 0
strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
Set objGroup = GetObject("LDAP://" & strGroupDN)
blnBound = True
End If
'Else
On Error GoTo 0
blnBound = True
'End If
If (blnBound = True) Then
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
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