<![CDATA[Серый форум — VBScript: Формирование списка пользователей из ADirectory в Excel]]> 2010-04-28T08:54:29Z PunBB https://forum.script-coding.com/viewtopic.php?id=2915 <![CDATA[Re: VBScript: Формирование списка пользователей из ADirectory в Excel]]> boodoo пишет:

... Задача - в новую АД перенести пользователей из старой, выгрузив их в текстовый файл.

Может быть проще воспользоваться встроенной командой "csvde"?
Выгрузить: csvde -f c:\ad.csv
Загрузить:  csvde -i -f c:\ad.csv

]]> 2010-04-28T08:54:29Z https://forum.script-coding.com/viewtopic.php?pid=35141#p35141 <![CDATA[Re: VBScript: Формирование списка пользователей из ADirectory в Excel]]> boodoo пишет:

... но objUser.Put "name" , arrUserFields(1) "Сервер не склонен обрабатывать...

Какое именно свойство "учётки" Вы пытаетесь таким оператором настроить?

Запустите приведённый ниже сценарий из-под какой-либо готовой "учётки":

Dim objSysInfo, objUser, strDN
Set objSysInfo = CreateObject("ADSystemInfo")
strDN = objSysInfo.UserName
Set objSysInfo = Nothing
Set objUser = GetObject("LDAP://" & strDN)
WScript.Echo objUser.name & vbNewLine & objUser.cn & vbNewLine & objUser.displayName & vbNewLine &_
            objUser.sAMAccountName & vbNewLine & objUser.userPrincipalName
Set objUser = Nothing
WScript.Quit 0

Думаю, что сразу станет понятной причина ошибки.

]]> https://forum.script-coding.com/profile.php?id=13351 2010-04-22T13:15:45Z https://forum.script-coding.com/viewtopic.php?pid=35001#p35001 <![CDATA[Re: VBScript: Формирование списка пользователей из ADirectory в Excel]]> Dmitrii, спасибо!  Подскажите еще, пожалуйста, как можно модифицировать существующие свойства объекта? Задача - в новую АД перенести пользователей из старой, выгрузив их в текстовый файл. Код, приведенный ниже работает,  

' Создаем пользователей 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

но objUser.Put "name" , arrUserFields(1) "Сервер не склонен обрабатывать...",
а objUser.PutEx ADS_PROPERTY_UPDATE, "name" , arrUserFields(1) вообще дает неопознанную ошибку!

]]> https://forum.script-coding.com/profile.php?id=25843 2010-04-22T10:36:58Z https://forum.script-coding.com/viewtopic.php?pid=34998#p34998 <![CDATA[Re: VBScript: Формирование списка пользователей из ADirectory в Excel]]> Dmitrii, спасибо. И я, наконец , сподобился прочитать:
Serverless Binding and RootDSE (Windows)
RootDSE (Windows)

]]> https://forum.script-coding.com/profile.php?id=1844 2010-04-20T06:01:41Z https://forum.script-coding.com/viewtopic.php?pid=34940#p34940 <![CDATA[Re: VBScript: Формирование списка пользователей из ADirectory в Excel]]> boodoo, рекомендую имя домена не задавать вручную, а определять программно. Пример:

Set objRoot = GetObject("LDAP://RootDSE")
strDNSDomain = objRoot.Get("DefaultNamingContext")
WScript.Echo strDNSDomain
]]> https://forum.script-coding.com/profile.php?id=13351 2010-04-20T05:37:14Z https://forum.script-coding.com/viewtopic.php?pid=34939#p34939 <![CDATA[Re: VBScript: Формирование списка пользователей из ADirectory в Excel]]> Более корректно, ИМХО, использовать вместо "DisplayName" поле "cn" или выводить их вместе. Кроме этого, мне для переноса юзеров в новый домен интересно еще и поле "UserAccountControl" для исключения мертвых душ. Для нормальных юзеров его значение равно 512, для отключенных - 514 и так далее

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

Dim objRootDSE, strDNSDomain, strBase
Dim adoCommand, adoConnection, objRS, strFilter, strAttributes, strQuery
Dim objExcel, strName, strPhone, strMail, strOtherphone, arrOtherPhone, strItem
Dim strsAMAccountName,strTitle,strDepartment,strMobile,strHomePhone,strEnUser

On Error Resume Next
strDNSDomain = "dc=<domain>, dc=ru"

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 = False
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(0,4).Value = "Внутренний телефон"
objExcel.ActiveCell.Offset(0,5).Value = "Мобильный телефон"
objExcel.ActiveCell.Offset(0,6).Value = "Домашний телефон"
objExcel.ActiveCell.Offset(0,7).Value = "Учётная запись"
objExcel.ActiveCell.Offset(0,8).Value = "Электронная почта"
objExcel.ActiveCell.Offset(0,9).Value = "Enable"
objExcel.ActiveCell.Offset(1,0).Activate                'переход на следующую строку.


strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user))"
'strAttributes = "name,mail,telephoneNumber,otherTelephone"
strAttributes = "cn,sAMAccountName,title,department,mail,telephoneNumber,otherTelephone,mobile,homePhone,UserAccountControl"


' Формируем строку запроса.
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("cn").Value
    strMail = objRS.Fields("mail").value
    strPhone = objRS.Fields("telephoneNumber").Value
    strsAMAccountName = objRS.Fields("sAMAccountName").Value
    strTitle = objRS.Fields("title").Value
    strDepartment = objRS.Fields("department").Value
    strMobile = objRS.Fields("mobile").Value
    strHomePhone = objRS.Fields("homePhone").Value
    arrOtherPhone = objRS.Fields("otherTelephone").Value
    strEnUser = objRS.Fields("UserAccountControl").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 = strTitle
    objExcel.ActiveCell.Offset(0,2).Value = strDepartment
    objExcel.ActiveCell.Offset(0,3).Value = strPhone
    objExcel.ActiveCell.Offset(0,4).Value = strOtherPhone
    objExcel.ActiveCell.Offset(0,5).Value = strMobile
    objExcel.ActiveCell.Offset(0,6).Value = strHomePhone
    objExcel.ActiveCell.Offset(0,7).Value = strsAMAccountName
    objExcel.ActiveCell.Offset(0,8).Value = strMail
    objExcel.ActiveCell.Offset(0,9).Value = strEnUser
    objExcel.ActiveCell.AutoFormat
    objExcel.ActiveCell.Offset(1,0).Activate
    
    objRS.MoveNext
Wend

' Чистим память.
Set objRS = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing
objExcel.Visible = True
msgbox("Скрипт работу закончил!!!")
]]> https://forum.script-coding.com/profile.php?id=25843 2010-04-20T03:29:16Z https://forum.script-coding.com/viewtopic.php?pid=34938#p34938 <![CDATA[Re: 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
]]> https://forum.script-coding.com/profile.php?id=5879 2009-03-13T08:30:10Z https://forum.script-coding.com/viewtopic.php?pid=20617#p20617 <![CDATA[VBScript: Формирование списка пользователей из ADirectory в Excel]]> Задача: Необходимо создать список пользователей из AD в таблицу Excel, при этом у некоторых пользователей не указаны дополнительные телефоны.

Вопрос: Проблема состоит в том, что у пользователей с неуказанными дополнительными телефонами поле OtherTelephone = не установлено, соответственно условие (otherTelephone=*) для них не выполняется.

Каким образом можно построить запрос, чтобы в него попадали и пользователи с дополнительными телефонами, и с пустыми значениями ?


Сам скрипт: 

strDomainDN = "DC=test,DC=LOCAL"  

strBase   =  "<LDAP://" & strDomainDN & ">;"

'По кодам UseraccountControl Смотреть. http://support.microsoft.com/kb/305144
strFilter = "(&(objectClass=person)(objectClass=user)(otherTelephone=*)(|(useraccountControl=66048)(useraccountcontrol=512))(!(objectClass=computer)));" 
strAttrs  = "Name,mail,telephoneNumber,otherTelephone;" 'Фильтр
strScope  = "subtree"

Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add

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


Set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
Set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
i = objRS.Fields.Count
WScript.Echo i

while Not objRS.EOF
  
For Each Field in objRS.fields("otherTelephone").value 'Перебераем OtherTelephone, а вдруг там есть еще какие-либо телеофны помимо одного мобильника
 OtherTelephone = OtherTelephone + Field + " "
 WScript.Echo otherTelephone
Next 

    objExcel.ActiveCell.Value = objRS.Fields(0).Value
    objExcel.ActiveCell.Offset(0,1).Value = objRS.Fields(1).Value
    objExcel.ActiveCell.Offset(0,2).Value = objRS.Fields(2).Value
    objExcel.ActiveCell.Offset(0,3).Value = objRS.Fields(3).Value
    objExcel.ActiveCell.Offset(0,3).Value = OtherTelephone
    objExcel.ActiveCell.Offset(1,0).Activate
    objRS.MoveNext
OtherTelephone = Empty
Wend
]]> https://forum.script-coding.com/profile.php?id=5879 2009-03-12T13:42:24Z https://forum.script-coding.com/viewtopic.php?pid=20594#p20594