AD и Excel

[sirius24]

Доброго времени суток!

Очень нужно экспортировать данные из AD в Excel. Нашел один работающий скрипт, только есть одна проблема: выводит только одну группу, к которой принадлежит юзер. Подскажите, пожалуйста, как сделать, чтобы выводил все группы, к которым подключен пользователь.

Public Sub importad()

    Const ADS_SCOPE_SUBTREE = 6 ' глубина анализа Active Directory
    
    Dim attr(20, 5): ac = 0: mailat = -1 ' определение значений
    
    ' Массив запрашиваемых атрибутов. Порядок определяется порядком в коде благодаря
    ' увеличению индекса в каждой строке.
    ' Для атрибута mail задается дополнительная переменная-индекс для фильтра в дальнейшем.
    
    attr(ac, 1) = "Полное имя": attr(ac, 2) = "cn": ac = ac + 1
    attr(ac, 1) = "Отображаемое имя": attr(ac, 2) = "displayname": ac = ac + 1
    attr(ac, 1) = "Фамилия": attr(ac, 2) = "sn": ac = ac + 1
    attr(ac, 1) = "Имя": attr(ac, 2) = "givenName": ac = ac + 1
    attr(ac, 1) = "группа": attr(ac, 2) = "memberof": ac = ac + 1
    attr(ac, 1) = "Телефон": attr(ac, 2) = "telephoneNumber": ac = ac + 1
    attr(ac, 1) = "E-mail": attr(ac, 2) = "mail": mailat = ac: ac = ac + 1 ' mailat - атрибут элемента E-mail
    attr(ac, 1) = "Alias": attr(ac, 2) = "samaccountname": ac = ac + 1
    
    For i = 0 To ac ' Заполнение заголовка
        Cells(2, i + 1).Value = attr(i, 1)
    Next i
    
    ' Создание подключения
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    
    Set objCommand.ActiveConnection = objConnection
    objCommand.Properties("Page Size") = 100 ' размер страницы
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE ' глубина анализа
    
    ' формирование строки атрибутов
    atts = ""
    For i = 0 To ac
        atts = atts & attr(i, 2) & ","
    Next i
    atts = Mid(atts, 1, Len(atts) - 2) ' перечень запрашиваемых атрибутов
    
    ' определение домена текущего пользователя
   ' domain = Environ("USERDNSDOMAIN")
   ' da = Split(domain, ".")
   ' st = "dc=" & da(UBound(da) - 1) & ",dc=" & da(UBound(da)) ' путь подключения к LDAP
    
    objCommand.CommandText = _
        "SELECT " & atts & " FROM " _
            & "'LDAP://****.local/OU=******,DC=****,DC=local' WHERE " _
                & "objectCategory='user'"
    Set objRecordSet = objCommand.Execute ' выполнение запроса
    
    ' начало заполнения таблицы Excel
    
    objRecordSet.MoveFirst ' первая запись
    
    x = 3 ' первая строка для импорта
    
    Do Until objRecordSet.EOF ' пока не закончатся записи
    
        If objRecordSet.Fields(attr(mailat, 2)) <> "" Or Cells(1, 1) = False Then ' проверка пустой почты
            For i = 0 To ac - 1
                Cells(x, i + 1).Value = objRecordSet.Fields(attr(i, 2)).Value
            Next i
            x = x + 1
        End If
        objRecordSet.MoveNext
        
    Loop
    

End Sub

[Teslenko_EA]

Здравствуйте sirius24.
SQL конструкция запроса, получает данные только базовой группы к которой принадлежит пользователь. Для получения списка групп членом которой является пользователь, подобная конструкция даже с переделанным запросом - не самое удачное решение, т.к. существующее отношение (каждый пользователь может быть членом многих групп), не корректно будет отображать запрашиваемые данные.

помочь Вам в создании верного решения смогу оказать не раньше вторника (30/04/2010), ввиду отсутствия в домашних условиях AD.

встречный вопрос: откуда у Вас этот VBA код, изобилующий бесполезными нагромождениями

Евгений.

[sirius24]

Здравствуйте, Евгений!

Буду очень надеяться на Вашу помощь! Запрос нашел в интернете