Продолжение темы начатой в Создание и синхронизация личных папок пользователей. Perl.
На этот раз реализация на VBS.

Для работы также требует Xcacls.

'------------------------------------------------------------------
'Name:		create_exchg.vbs
'Version:	0.9.0
'Created:	Andrey Orlov
'Email:		tangarus(a)gmail.com
'Web:		http://www.tangarus.ru/
'Date:		10.2009
'Description:Создание и синхронизация личных папок пользователей
'------------------------------------------------------------------
 
DIM UserSN 
 
Const UNCShareFolder = "\\dcserver\eXchange\" ' - Шара на сервере 
Const WorkLogPath = "c:\foldertest\" ' - для логов папка 
Const OUAccounts = "Std users" ' - OU где брать пользователей 
Const SlashDomain = "MYDOMAIN\" ' - переменная для подстановки NetBIOS имя домена + слэш. 
 
Set oShell = CreateObject("WScript.Shell") 
Set WshShell = CreateObject("WScript.Shell") 
Set FileSys = CreateObject("Scripting.FileSystemObject") 
Set objConnection = CreateObject("ADODB.Connection") 
Set objCommand = CreateObject("ADODB.Command") 
objConnection.Provider = "ADsDSOOBject" 
objConnection.Open "Active Directory Provider" 
Set objCommand.ActiveConnection = objConnection 
 
Set objRootDSE = GetObject("LDAP://RootDSE") 
strDNSDomain = objRootDSE.Get("defaultNamingContext") 
strFilter = "(&(objectCategory=user))" 
strQuery = "<LDAP://ou=" & OUAccounts & "," & strDNSDomain & ">;" & strFilter _ 
& ";distinguishedName;subtree" 
 
objCommand.CommandText = strQuery 
Set objRecordSet = objCommand.Execute 
 
 
Do Until objRecordSet.EOF 
	strDN = objRecordSet.Fields("distinguishedName") 
	Set objUser = GetObject("LDAP://" & strDN) 
 
	FSH( UNCShareFolder & objUser.Get("DisplayName")) 
 
	sCmd = "c:\windows\system32\cscript c:\windows\xcacls.vbs """& UNCShareFolder & objUser.Get("DisplayName") & """ /I ENABLE /g " & SlashDomain & objUser.Get("SAMAccountname") & ":f;o /L " & WorkLogPath & "scmd1.txt" 
	oShell.Run sCmd,0,true 
 
	objRecordSet.MoveNext 
Loop 
 
MsgBox("Формирование каталога и назначение прав пользователю выполненно") 
 
Function FSH(path) 
Set fso = CreateObject("Scripting.FileSystemObject") 
If (Not fso.FolderExists(path)) Then 
	Set oNewFolder = fso.CreateFolder(path) 
End If 
End Function