• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1350
  • Last Modified:

create home directory with Windows script

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
0
jskfan
Asked:
jskfan
  • 3
  • 2
1 Solution
 
RobSampsonCommented:
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

0
 
jskfanAuthor Commented:
is the only way to d it through script? GPO wouldn't?
0
 
RobSampsonCommented:
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.
0
 
jskfanAuthor Commented:
can you please comment each line of the script. I know it s a long script.
0
 
RobSampsonCommented:
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

0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now