' Часть 1: открыть электронную таблицу Excel 
? с помощью ADO.
Dim oCN
Set oCN = CreateObject("ADODB.Connection")
oCN.Open "Excel"

Dim oRS
Set oRS = oCN.Execute("SELECT * FROM [Sheet1$]")

' Часть 2: получить ссылку на домен NT 
? с помощью ADSI.
Dim oDomain
Dim sPDC
sPDC = "NT4PDC"
Set oDomain = GetObject("WinNT://" & sPDC)

' Часть 3: открыть выходной текстовый файл.
' для хранения начальных паролей пользователей.
Dim oFSO, oTS
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTS = oFSO.CreateTextFile("C:passwords.txt",True)

' Часть 4: для каждой записи в наборе.
' добавить пользователя, установить соответствующие 
' свойства пользователя и занести пользователей в
' соответствующие группы.

' Определить необходимые переменные.
Dim sUserID, sFullName, sDescription
Dim sHomeDir, sGroups, sDialIn
Dim sPassword, oUserAcct, oFolder
Dim sGroupList, iTemp, oGroup

' Определить базовый путь для создания
' личных каталогов.
Dim sHomePath, sMsg
sHomePath = "iridis1c$users"

' Поочередно обработать строки набора записей
Do Until oRS.EOF

	' Получить информацию о пользователе из данной 
	? строки.
	sUserID = oRS("UserID")
	sFullName = oRS("FullName")
	sDescription = oRS("Description")
	sHomeDir = oRS("HomeDirectory")
	sGroups = oRS("Groups")
	sDialIn = oRS("DialIn")

	' Составить новый пароль.
	sPassword = Left(sUserID,2) _
		& DatePart("n",Time) & DatePart("y",Date) _
		& DatePart("s",Time)

	' Создать учетную запись пользователя.
	On Error Resume Next
	Set oUserAcct = oDomain.Create("user",sUserID)
	If Err <> 0 Then
	sMsg = "Ошибка при попытке создать пользователя " _
			& sUserID & vbCrLf & vbCrLf
		sMsg = sMsg & "Описание ошибки: " _
			& Err.Description
		MsgBox sMsg
	End If
	On Error Goto 0
	' Назначить свойства учетной записи.
	oUserAcct.SetPassword sPassword
	oUserAcct.FullName = sFullName
	oUserAcct.Description = sDescription
	oUserAcct.HomeDirectory = sHomeDir

	' Назначить полномочия RAS.
	If sDialIn = "Y" Then
		oUserAcct.RasPermissions = 9
	Else
		oUserAcct.RasPermissions = 1
	End If

	' Сохранить учетную запись.
	oUserAcct.SetInfo

	' Получить ссылку на новую учетную запись.
	' Данный шаг дает действительный SID и
	' другую информацию.
	Set oUserAcct = GetObject("WinNT://" _
		& sPDC & "/" & sUserID & ",user")

	' Записать пароль в файл.
	oTS.Write sUserID & "," & sPassword _
		& vbCrLf

	' Часть 4A: занести учетные записи пользователей в 
	? группы.
	' Преобразовать разделенный запятыми список в
	' массив с помощью функции Split.
	sGroupList = Split(sGroups, ",")

	' Пройти по массиву и добавить
	' пользователя в каждую группу.
	For iTemp = 0 To uBound(sGroupList)

		' Получить группу.
		Set oGroup = GetObject("WinNT://" & _
			sPDC & "/" & sGroupList(iTemp) _
			& ",group")

		' Добавить учетную запись пользователя.
		oGroup.Add oUserAcct.ADsPath

		' Release the group.
		Set oGroup = Nothing

	Next

	' Часть 4B: создать личный каталог пользователя.
	' (Присоединить UserID к переменной Home Path).
	Set oFolder = oFSO.CreateFolder(sHomePath _
		& sUserID)

	' Часть 5: освободить учетную запись пользователя.
	Set oUserAcct = Nothing

	' Перейти к следующей строке набора записей.
	oRS.MoveNext

Loop

? Часть 6: завершающая очистка и закрытие файлов.
oRS.Close
oTS.Close
WScript.Echo "Пароли сохранены в файле " _
	& " C:passwords.txt."

Поделитесь материалом с коллегами и друзьями