Solved

Modify Home Drive & Folder for all Users in an OU

Posted on 2009-05-14
4
411 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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 it comes to writing scripts for a Client/Server computing environment it is essential to consider some way of enabling the authentication functionality within a script. This sort of consideration mainly comes into the picture when we are dealin…
This video Micro Tutorial shows how to password-protect PDF files with free software. Many software products can do this, such as Adobe Acrobat (but not Adobe Reader), Nuance PaperPort, and Nuance Power PDF, but they are not free products. This vide…
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…

690 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