Solved

Modify Home Drive & Folder for all Users in an OU

Posted on 2009-05-14
4
389 Views
Last Modified: 2012-08-14
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?
0
Comment
Question by:jring_3770
  • 2
  • 2
4 Comments
 
LVL 17

Accepted Solution

by:
Jared Luker earned 500 total points
ID: 24389969
This is one that I already had sitting around.  It might need some tweaking:

You will need to change the LDAP query to match your OU structure.
Set WshShell = WScript.CreateObject("WScript.Shell")

Set WshSysEnv = WshShell.Environment("SYSTEM")

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set WshNetwork = WScript.CreateObject("WScript.Network")	'Network Object
 

	'This section deals with searching AD for the user account

	'On Error Resume Next

	

	Const ADS_SCOPE_SUBTREE = 2

	

	Set objConnection = CreateObject("ADODB.Connection")

	Set objCommand =   CreateObject("ADODB.Command")

	objConnection.Provider = "ADsDSOObject"

	objConnection.Open "Active Directory Provider"

	Set objCommand.ActiveConnection = objConnection

	

	objCommand.Properties("Page Size") = 1000

	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

	

	objCommand.CommandText = _

	    "SELECT ADsPath, homeDirectory, samAccountName, Department, DepartmentNumber FROM 'LDAP://OU=Users,DC=company,DC=com' WHERE objectCategory='user' "

	Set objRecordSet = objCommand.Execute

	

	objRecordSet.MoveFirst

	'Do Until objRecordSet.EOF

	While Not objRecordset.EOF

	    strUser = objRecordSet.Fields("ADsPath").Value

	    'WScript.Echo strUser

	    Set objUser = GetObject(strUser)

'	    DeptName = objRecordSet.Fields("Department").Value

'	    WScript.Echo DeptName

'	    DeptNum = objRecordset.Fields("DepartmentNumber").Value

'	    WScript.Echo DeptNum

		strHomeDir = LCase(objuser.homeDirectory)

		'WScript.Echo strHomeDir

		strHomeDirServer = Mid(strHomeDir,3,11)

		If strHomeDirServer = "z02rsislc01" Then

			WScript.Echo strUser

			strNewHomeDir = Replace(strHomeDir,"server01","server02")

			'WScript.Echo strnewHomeDir

			objUser.homeDirectory = strNewHomeDir

			objUser.Setinfo

			

	    End If

	    

	    

	    objRecordSet.MoveNext

	 Wend

Open in new window

0
 
LVL 17

Expert Comment

by:Jared Luker
ID: 24390016
So you will need to change line 21, 37, and 39 at a minimum.
0
 

Author Comment

by:jring_3770
ID: 24394473
Thanks, I will give this a try and get back to you.
0
 

Author Comment

by:jring_3770
ID: 24394761
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
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

Open in new window

NewUsers.xls
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Script to copy or move mouse-selected collection of files plus targets referenced by shortcuts (.lnk) The purpose of this article is to help illuminate the real challenges and options available (where they may exist) for utilizing simple scriptin…
Hello again, all.  For those of you that have been following along, you'll know that this is my third article on this topic (though it is not Part III).  This article is sort of remedial, and probably the topic with which I should have started the s…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now