createUserShare.vbs

Assume you have an Active Directory Domain, with a number of users, and at some point you want to introduce home directories on a file server for each user, or you want to implement roaming profiles. In stead of editing each user account one by one, you may want a script to do it for you. You therefore want to :

1. get all user names
2. create a directory for each user
3. set the NTFS security to each folder so that (only) the user can read from and write to it - and maybe give control to the administrator just in case.

This script does exactly that. It can be seen as an alternative to createUsers.bat, which creates the users and sets the shares in one go.

' Koen Noens, 
' June 2005
'
'Based on
'How to Create User Shares for All Users in a Domain with ADSI
'http://support.microsoft.com/?kbid=234746
'
'	script creates a share for every user in the domain,
'	assigns this share as 'home directory' for the user
'	maps a drive letter the to the share, and
'	sets NTFS security
'
'====================================================================

'param
Domain = 	"KICKS"
ParentDir = 	"C:\Users"
HomeDrive =  	"P:"


' option to use hidden shares
Hidden = 0	'False
'Hidden = MsgBox("Do you want the user shares to be hidden? If yes, the share will be username$; If no, the share will be username", 4, "Hidden Shares?")
'Hidden = Hidden - 7

'Preps : objects etc
Set fso = CreateObject("Scripting.FileSystemObject")
Set oWSHNetwork = CreateObject("WScript.Network")
Set oShell = CreateObject("WScript.Shell")

'get user accounts
Set DomainObj = GetObject("WinNT://" & Domain)
DomainObj.Filter = Array("User")

For Each UserObj in DomainObj
	
	If UserObj.Name <> "Administrator" Then

		'create a folder and make a share name
		HomeFolder = ParentDir & "\" & UserObj.Name
  		If fso.FolderExists(HomeFolder) = 0 Then	'folder doesn't exist
			fso.CreateFolder HomeFolder
		End If
  		ShareName = UserObj.Name

		'set NTFS for home directory
		setNTFS HomeFolder, UserObj.Name

  		'If Hidden Then
    		'	ShareName = ShareName & "$"
  		'End If

		'create the share 
		ShareCommand = "Net Share " & ShareName & "=" & HomeFolder & " /USERS:2 /CACHE:Automatic"
		ShareCommand = "cmd /C " & ShareCommand
		oShell.Run ShareCommand

		'update the user account
  		UserObj.HomeDirectory = "\\" & oWSHNetwork.ComputerName & "\" & ShareName
    		UserObj.HomeDirDrive = HomeDrive 'Requires ADSI 2.5
			
				'alt: share form roaming user profile
				' UserObj.Profile = HomeFolder	
    		UserObj.SetInfo
  		
	End If
Next


'clean up
Set fso = Nothing
Set oWSHNetwork = Nothing
Set oShell = Nothing
MsgBox "Script Complete",, "Finished"
Wscript.Quit


'-------------------------------------------
'subroutines and functions
'-------------------------------------------

Sub setNTFS (DirectoryPath, UserName)
' use XCALCS in shell to set NTFS permissions
'
'	replace permissions to remove any unwanted settings
'	set	Administrators  : Full Controll
'		User		: Change (Read, Write)
'		(Other Users	: none)


	QUOTE = chr(34)

	Set objShell = CreateObject("WScript.Shell") 

	CommandString = Commandstring & "CACLS "		'command to be executed
								'command options and parameters
	CommandString = Commandstring & _
				DirectoryPath & " " & _
				"/G " & _
				"Administrator:F " & _
				UserName & ":C"

	CommandString = "echo Y|" & Commandstring 		'CALCS requires confirmation
	CommandString = "CMD /C " & QUOTE & Commandstring & QUOTE	
	wscript.echo commandstring
	objShell.Run CommandString

	Set objShell= Nothing
End Sub