VBScript: Формирование списка пользователей из ADirectory в Excel

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Создаем список активных пользователей из Active directory в 
'таблицу формата Excel
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Dim objRootDSE, strDNSDomain, strBase
Dim adoCommand, adoConnection, objRS, strFilter, strAttributes, strQuery
Dim objExcel, strName, strPhone, strMail, strOtherphone, arrOtherPhone, strItem

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

'Работаем с Excel
Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add

objExcel.ActiveSheet.Name = "Users " & Left(strDNSDomain,19) & "..."
objExcel.ActiveSheet.Range("A1").Activate

objExcel.ActiveCell.Value = "Имя пользователя"    
objExcel.ActiveCell.Offset(0,1).Value = "Электронная почта "    
objExcel.ActiveCell.Offset(0,2).Value = "Телефон "    
objExcel.ActiveCell.Offset(0,3).Value = "Моб. Номер "    
objExcel.ActiveCell.Offset(1,0).Activate                'переход на следующую строку.


strBase = "<LDAP://" & strDNSDomain & ">"

' Найти все активные учетные записи.
' По кодам UseraccountControl Смотреть. http://support.microsoft.com/kb/305144
strFilter = "(&(objectCategory=person)(objectClass=user)(|(useraccountControl=66048)(useraccountcontrol=512)))"
strAttributes = "name,mail,telephoneNumber,otherTelephone"


' Формеруем строку запроса.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

' Выполним запрос.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 307
adoCommand.Properties("Cache Results") = False
Set objRS = adoCommand.Execute


While not objRS.EOF

    strName = objRS.Fields("name").Value
    strMail = objRS.Fields("mail").value
    strPhone = objRS.Fields("telephoneNumber").Value

    arrOtherPhone = objRS.Fields("otherTelephone").Value
    If IsNull(arrOtherPhone) Then
        strOtherPhone = ""
    Else
        strOtherPhone = ""
        For Each strItem In arrOtherPhone
            If (strOtherPhone = "") Then
                strOtherPhone = strItem
            Else
                strOtherPhone = strOtherPhone & " " & strItem
            End If
        Next
    End If
    
    'Заполним поля
    objExcel.ActiveCell.Value = strName
    objExcel.ActiveCell.Offset(0,1).Value = strMail
    objExcel.ActiveCell.Offset(0,2).Value = strPhone
    objExcel.ActiveCell.Offset(0,3).Value = strOtherPhone
    objExcel.ActiveCell.AutoFormat
    objExcel.ActiveCell.Offset(1,0).Activate
    
    objRS.MoveNext
Wend

' Чистим память.
Set objRS = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing

Set objRoot = GetObject("LDAP://RootDSE")
strDNSDomain = objRoot.Get("DefaultNamingContext")
WScript.Echo strDNSDomain

' Создаем пользователей d Active directory из 
' текстового файла ADCreateUser.txt. Структура файла:
' - каждая строка из двух полей (cn, sAMAccountName),
' разделенных ";"
' - строка закрыта vbCrLf

Option Explicit
Dim objRoot, objAD, objUser, objFSO, objFile, objUserModify
Dim arrFileLines(), arrUserFields, strArr
Dim strDomain, strUser,strContainer, strPassword, strUserList, strUserName
Dim timeStart, timeStop, timeConn, i, j, k

Const ADS_PROPERTY_UPDATE = 2

timeStart = Time()

'Определяем пространство имен
Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")

'Инициализируем переменные
strContainer = "cn=users," & strDomain
strPassword = "QAZwsx123"
strUserList = "ADdUsers.txt"
i = 0
j = 0
k = 1

'Открываем файл со списком пользователей
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strUserList, 1)

'Считываем содержимое файла в массив
Do Until objFile.AtEndOfStream
     Redim Preserve arrFileLines(i)
     arrFileLines(i) = objFile.ReadLine
     i = i + 1
Loop

'Закрываем файл
objFile.Close

'Выбираем пользователя из массива и добавляем его в контейнер Users
For j = Ubound(arrFileLines) to LBound(arrFileLines) Step -1
    'Подключаемся к контейнеру Users для добавления пользователя
    Set objAD = GetObject("LDAP://" & strContainer)
    arrUserFields = Split(arrFileLines(j), ";")
    Set objUser = objAD.Create("User", "cn=" & arrUserFields(0))
    objUser.Put "sAMAccountName", arrUserFields(0)
    objUser.Put "userPrincipalName", arrUserFields(0) & <domain>
    objUser.Put "displayName", arrUserFields(1)
    objUser.SetInfo

    'objUser.Put "name" , arrUserFields(1)
              'objUser.PutEx ADS_PROPERTY_UPDATE, "name" , arrUserFields(1)
    objUser.AccountDisabled = False
    objUser.SetPassword strPassword 'задать пароль
    objUser.SetInfo
    k = k + 1
    
Next

timeStop = Time()
msgbox "Added accouns: " & k & vbCrLf & timeStop & vbCrLf & timeStart

'Ликвидируем оъекты
Set objRoot = Nothing
Set objAD = Nothing
Set objUser = Nothing
Set objUserModify = Nothing
Set objFSO = Nothing
Set objFile = Nothing