We help IT Professionals succeed at work.

We've partnered with Certified Experts, Carl Webster and Richard Faulkner, to bring you two Citrix podcasts. Learn about 2020 trends and get answers to your biggest Citrix questions!Listen Now

x

create home directory with Windows script

jskfan
jskfan asked
on
Medium Priority
1,420 Views
Last Modified: 2012-05-06
I need to configure home directory for all users. Do I have to go to each user properties in AD and set it up manually or there is a script that would do that for me OR there is a policy that can do that?

thanks
Comment
Watch Question

CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
Hi there.

You can try this script.  This requires that xcacls.vbs is in your System32 folder

You can change this line:
      If Left(objRecordSet.Fields("adsPath").Value, 19) = "LDAP://CN=Test Account" Then

so that CN=Test Account matches the display name of one user that you want to test this against.

Change these two lines
strHomeDrive = "N:"
strHomeShare = "\\fileserver\user$"

so that the strHomeShare points to the parent folder (which is shared) where your user drives are to be created.

Regards,

Rob.
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 
 
Set objNetwork = CreateObject("WScript.Network")
strDomain = objNetwork.UserDomain
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
objCommand.CommandText = _
    "SELECT adsPath FROM 'LDAP://" & strDNSDomain & "' WHERE objectCategory='user'"
Set objRecordSet = objCommand.Execute
 
strHomeDrive = "N:"
strHomeShare = "\\fileserver\user$"
If Right(strHomeShare, 1) = "\" Then strHomeShare = Left(strHomeShare, Len(strHomeShare) - 1)
MsgBox strHomeShare
While Not objRecordSet.EOF
	If Left(objRecordSet.Fields("adsPath").Value, 19) = "LDAP://CN=Test Account" Then
		Set objUser = GetObject(objRecordSet.Fields("adsPath").Value)
		MsgBox "Found " & objUser.samaccountname
		SetHomeDir strDomain, strHomeShare, objUser.samaccountname, False
		objUser.HomeDrive = strHomeDrive
		MsgBox strHomeShare & VbCrLf & strHomeShare & "\" & objUser.samAccountName
		objUser.HomeDirectory = strHomeShare & "\" & objUser.samAccountName
		objUser.SetInfo
	End If
	objRecordSet.MoveNext
Wend
MsgBox "Done."
 
Sub SetHomeDir(ByVal sDomain, ByVal sShare, ByVal sUser, ByVal bCreateUserShare)
	Dim objFSO, objShell, sHomeDir, strCommand, strServer, strFolder, arrPath, strLocalPath, objWMIService, colItems, objItem, objNewShare, errReturn
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objShell = CreateObject("WScript.Shell")
	If Right(sShare, 1) <> "\" Then sShare = sShare & "\"
	sHomeDir = sShare & sUser
	sUser = sDomain & "\" & sUser
	If objFSO.FileExists(objFSO.GetSpecialFolder(1) & "\xcacls.vbs") = True Then
		If objFSO.FolderExists(sHomeDir) = False Then
			objFSO.CreateFolder(sHomeDir)
			Set objShell = CreateObject("WScript.Shell")
			' Set the permissions on the folder using XCacls.vbs downloaded from Microsoft and stored in %systemroot%\System32\
			strCommand = "%COMSPEC% /c cscript.exe %systemroot%\System32\xcacls.vbs " & sHomeDir & " /E /T /G "& sUser & ":F"
			objShell.Run strCommand, 1, True
		End If
		If bCreateNewShare = True Then
			' Obtain the local path to the sShare: http://www.microsoft.com/technet/scriptcenter/resources/qanda/mar06/hey0316.mspx
			If Right(sShare, 1) = "\" Then sShare = Left(sShare, Len(sShare) - 1)
			arrPath = Split(Replace(sShare, "\\", ""), "\")
			strServer = arrPath(0)
			strFolder = arrPath(UBound(arrPath))
			Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
			Set colItems = objWMIService.ExecQuery _
			    ("Select * From Win32_Share Where Name = '" & strFolder & "'")
			For Each objItem in colItems
			    ' This would return something like D:\Users
			    strLocalPath = objItem.Path
			Next
			
			' Then create the new share on that servers local path: http://www.microsoft.com/technet/scriptcenter/resources/qanda/jan05/hey0107.mspx
			Const FILE_SHARE = 0
			Const MAXIMUM_CONNECTIONS = 25
			Set objNewShare = objWMIService.Get("Win32_Share")
			' Take the domain name off the sUser again
			sUser = Replace(sUser, sDomain & "\", "")
			errReturn = objNewShare.Create (strLocalPath & "\" & sUser, sUser, FILE_SHARE, _
			        MAXIMUM_CONNECTIONS, "Home folder share for " & sUser)
			If errReturn <> 0 Then
				MsgBox "There was an error creating the share on the folder" & VbCrLf & strServer
			End If
		End If
	Else
		MsgBox "Xcacls.vbs does not exist in the System32 folder.  Cannot create home folder."
	End If
End Sub

Open in new window

Author

Commented:
is the only way to d it through script? GPO wouldn't?
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
Hi, as far as I know, yes, a script is the only way.  Group Policy by itself cannot create a folder and apply network permission....

Rob.

Author

Commented:
can you please comment each line of the script. I know it s a long script.
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014
Commented:
Hi, see if this commented enough....

Regards,

Rob.
' Set a constant for the ADS search scope for subtree searches
' You can also use OneLevel only with a value of 1 to not search subtrees
Const ADS_SCOPE_SUBTREE = 2
 
' Create the ADODB Connection objects and set it to the AD provider
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
' Set the AODOB query Page Size and scope
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
' Create a Network object to get the domain name from
Set objNetwork = CreateObject("WScript.Network")
strDomain = objNetwork.UserDomain
' Bind to the RootDSE object in the domain to get the naming context
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
' Set the query command text to look for user objects only
objCommand.CommandText = _
    "SELECT adsPath FROM 'LDAP://" & strDNSDomain & "' WHERE objectCategory='user'"
' Execute the query
Set objRecordSet = objCommand.Execute
 
' Set the home drive letter that you want to change each user to
strHomeDrive = "N:"
' Set the initial home folder share where user folders will be created into
strHomeShare = "\\fileserver\user$"
If Right(strHomeShare, 1) = "\" Then strHomeShare = Left(strHomeShare, Len(strHomeShare) - 1)
 
' Loop through the recordset of all users
While Not objRecordSet.EOF
	' This line can be set to one test account to change the home drive of
	' If you want to change the home drive of all accounts, command out the
	' If statement below, and the End If above objRecordSet.MoveNext
	If Left(objRecordSet.Fields("adsPath").Value, 19) = "LDAP://CN=Test Account" Then
		' Bind to the user account
		Set objUser = GetObject(objRecordSet.Fields("adsPath").Value)
		' Call the SetHomeDir procedure to create the folder and apply NTFS permissions to it
		' SetHomeDir takes the following parameters
		' 1 - domain name
		' 2 - initial folder share to create the users folders in
		' 3 - the login name of the user account (the name of the folder to create)
		' 4 - boolean value that determines whether to make the new folder a new share itself
		SetHomeDir strDomain, strHomeShare, objUser.samaccountname, False
		' Set the HomeDrive for the user
		objUser.HomeDrive = strHomeDrive
		' Set the HomeDirectory for the user
		objUser.HomeDirectory = strHomeShare & "\" & objUser.samAccountName
		' Commit the changes
		objUser.SetInfo
	End If
	' Move to the next user in the recordset
	objRecordSet.MoveNext
Wend
MsgBox "Done."
 
Sub SetHomeDir(ByVal sDomain, ByVal sShare, ByVal sUser, ByVal bCreateUserShare)
	' SetHomeDir takes the following parameters
	' 1 - domain name
	' 2 - initial folder share to create the users folders in
	' 3 - the login name of the user account (the name of the folder to create)
	' 4 - boolean value that determines whether to make the new folder a new share itself
	Dim objFSO, objShell, sHomeDir, strCommand, strServer, strFolder, arrPath, strLocalPath, objWMIService, colItems, objItem, objNewShare, errReturn
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objShell = CreateObject("WScript.Shell")
	If Right(sShare, 1) <> "\" Then sShare = sShare & "\"
	' Set the home folder to the initial folder share, plus the username
	sHomeDir = sShare & sUser
	' Set the user name to the domain name, plus the user name
	sUser = sDomain & "\" & sUser
	' Check is xcacls.vbs exists in the System32 folder
	If objFSO.FileExists(objFSO.GetSpecialFolder(1) & "\xcacls.vbs") = True Then
		' Check if the user's home folder already exists
		If objFSO.FolderExists(sHomeDir) = False Then
			' If not, create the user's home folder
			objFSO.CreateFolder(sHomeDir)
			Set objShell = CreateObject("WScript.Shell")
			' Set the permissions on the folder using XCacls.vbs downloaded from Microsoft and stored in %systemroot%\System32\
			strCommand = "%COMSPEC% /c cscript.exe %systemroot%\System32\xcacls.vbs " & sHomeDir & " /E /T /G "& sUser & ":F"
			objShell.Run strCommand, 1, True
		End If
		' If the procedure has been instructed to create a new share on the new folder from the fourth parameter, create it
		If bCreateNewShare = True Then
			' Obtain the local path to the sShare: http://www.microsoft.com/technet/scriptcenter/resources/qanda/mar06/hey0316.mspx
			If Right(sShare, 1) = "\" Then sShare = Left(sShare, Len(sShare) - 1)
			arrPath = Split(Replace(sShare, "\\", ""), "\")
			strServer = arrPath(0)
			strFolder = arrPath(UBound(arrPath))
			Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
			' Get the details of the initial shared folder so we know where to create the new share
			Set colItems = objWMIService.ExecQuery _
			    ("Select * From Win32_Share Where Name = '" & strFolder & "'")
			For Each objItem in colItems
			    ' This would return something like D:\Users
			    strLocalPath = objItem.Path
			Next
			
			' Then create the new share on that servers local path: http://www.microsoft.com/technet/scriptcenter/resources/qanda/jan05/hey0107.mspx
			Const FILE_SHARE = 0
			Const MAXIMUM_CONNECTIONS = 25
			Set objNewShare = objWMIService.Get("Win32_Share")
			' Take the domain name off the sUser again
			sUser = Replace(sUser, sDomain & "\", "")
			errReturn = objNewShare.Create (strLocalPath & "\" & sUser, sUser, FILE_SHARE, _
			        MAXIMUM_CONNECTIONS, "Home folder share for " & sUser)
			If errReturn <> 0 Then
				MsgBox "There was an error creating the share on the folder" & VbCrLf & strServer
			End If
		End If
	Else
		MsgBox "Xcacls.vbs does not exist in the System32 folder.  Cannot create home folder."
	End If
End Sub

Open in new window

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.