Set objFSO=CreateObject("Scripting.FileSystemObject")
Set objNetwork=CreateObject("WScript.Network")
Set objShell=CreateObject("WScript.Shell")

strHomeLetter="H:"
strLocalPath="c:\users"
strHomeSrv="ITSERVER1"
strUsersDir="\\itserver1\users$"
strADSPath= CN=Jeff Hicks,OU=Gurus,DC=SAPIEN,DC=Local"

Set objUser = GetObject("LDAP://" & strADSPath)

Call MakeHomeDrive objUser,strHomeLetter,strLocalPath,strHomeSrv,_
strUsersDir,objUser.SAMAccountname


Sub MakeHomeDrive(objUser,strHomeLetter,strLocalPath,strHomeSrv,_
strUsersDir,strUserName)
On Error Resume Next

objUser.HomeDrive=strHomeLetter
objUser.HomeDirectory="\\" & strHomeSrv &"\" & strUserName & "$"
objUser.Profile="\\" & strHomeSrv & "\" & strUserName & "$"
objUser.SetInfo

objFSO.CreateFolder(strUsersDir & "\" & strUserName)

set objSrv=GetObject("WinNT://" & strHomeSrv & "/LanManServer")
set objNewShare=objSrv.Create("fileshare",strUserName & "$")
objNewShare.Path=strLocalPath & "\" & strUserName
objNewShare.MaxUserCount=2
objNewShare.SetInfo
'give the service a moment or two to finish this process
'before continuing.  The sleep time is in milliseconds.
WScript.Sleep 1000
'we need to temporarily map a drive to the user's new directory so we
'can set permissions
objNetwork.MapNetworkDrive "X:","\\" & strHomeSrv & "\" &_
 strUserName & "$"
    
'set permissions
'windows are hidden.  Change 0 to 1 to see windows
 objShell.Run "cmd /c echo y|cacls X:\ /g Administrators:F",0,True
 objShell.Run "cmd /c cacls X:\ /e /g " & objNetwork.UserDomain &_
 "\" & strUserName & ":C",0,True
    
'drop network connection
objNetwork.RemoveNetworkDrive "X:",True
End If

End Sub