create home directory with Windows script

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

Select allOpen in new window

is the only way to d it through script? GPO wouldn't?

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.

can you please comment each line of the script. I know it s a long script.