Форум программистов, компьютерный форум, киберфорум
VBA
Форум программистов и сисадминов Киберфорум > Форум программистов > Basic > VBA
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.68/34: Рейтинг темы: голосов - 34, средняя оценка - 4.68
1 / 1 / 0
Регистрация: 25.04.2014
Сообщений: 51
1

Active Directory - Получить список компьютеров из этой службы каталогов и вставить в таблицу Access

25.06.2014, 09:57. Показов 6162. Ответов 5
Метки нет (Все метки)
Author24 — интернет-сервис помощи студентам
На нашем предприятии используется Active Directory. Я бы хотел получить список компьютеров из этой службы каталогов и вставить в таблицу Access. Кроме имени компьютера, нужно также получить и вставить в таблицу атрибуты: description, whenChanged, whenCreated, lastLogonTimestamp, lastLogon
OU из которых брать компьютеры:
eur.XXX.com/FRP/SMZ/SMZ Workstations 7
eur.XXX.com/FRP/SMZ/SMZ Workstations 7 Lite
Домен контроллер, который нужно использовать: EURSMZ-HUB31.eur.XXX.com
Какова вероятность того, что кто-нибудь напишет для меня функцию? О_О
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 25.06.2014, 09:57
Ответы с готовыми решениями:

Получить список учетных записей MS Active Directory
Доброе утро, подскажите пожалуйста, если кто в курсе, какие нибудь winAPI функции или напрямую...

Закрывается explorer сам по себе. У всех компьютеров в домене Active Directory
Добрый день. В локальной сети по какой-то причине начал сам по себе закрываться explorer на всех...

access и active directory (AD) реально?
access и active directory (AD) реально? можно использовать имя пользователя(login) из AD чтобы...

MS access VBA + AD (active directory)
Всем привет. В общем есть инфа в AD ФИО, почта, тел должность. можно как то её с помощью Access и...

5
1261 / 147 / 32
Регистрация: 11.02.2011
Сообщений: 418
25.06.2014, 11:09 2
Не помню какая на форуме политика по ссылкам, так что приведу статью
Кликните здесь для просмотра всего текста
Достаточно часто системному администратору Windows приходится делать различные выгрузки по информации о пользователях домена Active Directory. Представим, что у нас есть список учетных записей (имена пользователя в формате samAccountName), и нам, например, необходимо получить информацию о том, в какой организации эти пользователи работают и их Canonical Name (CN). Ранее для получения такой информации мне приходилось писать небольшой скрипт на vbs, который последовательно перебирает все записи в Excel и возвращает обратно требуемую информацию из Active Directory. Такой механизм полностью работоспособен, но не очень удобен, поэтому я решил воспользоваться мощью языка Visual Basic from Application и выполнять запросы к Active Directory прямо из Excel (из макроса), т.к. такая методика была бы достаточно универсальной и в принципе все эти скрипты можно со спокойной совестью передавать менее подкованным бухгалтерам и экономистам!

Я создал новый макрос в книге Excel, и создал функцию с именем GetADInfo, которая на входе получает имя поля, по которому осуществляется поиск (в моем случае это имя пользователя, которое хранится в атрибуте Active Directory – samAccountName), значение этого поля (значение ячейки с именем пользователя) и имя артибута AD, значение которого функция должна вернуть.

Выполняем запрос к Active Directory из книги Excel

Как же все это работает? В моем примере в ячейке A2 содержится имя пользователя домена, и я хочу для этого пользователя узнать компанию, в которой он числится (поле AD “Company”) и его каноническое имя (поле AD «distinguishedName»), в этом случае формулы для ячеек соответственно будут выглядеть следующим образом:

Ячейка B2 (наименование организации):
Visual Basic
1

=GetADInfo("samAccountName";A2; "Company")
Ячейка C2 (CN):
Visual Basic
1

=GetADInfo("samAccountName";A2; "distinguishedName")
Код макроса на VBA для получения данных из AD следующий:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

Function GetADInfo(ByVal SearchField, ByVal SearchString, ByVal ReturnField)
 
' Указываем  имя домена ("dc=domain, dc=local")
 
Dim adoCommand, strDomain, objConnection
 
strDomain = "dc=winitpro,dc=ru"
 
Set objConnection = CreateObject("ADODB.Connection")
 
objConnection.Open "Provider=ADsDSOObject;"
 
' Подключаемся
 
Set adoCommand = CreateObject("ADODB.Command")
 
adoCommand.ActiveConnection = objConnection
 
' Рекурсивный поиск по AD, начиная с корня домена
 
adoCommand.CommandText = _
 "<LDAP://" & strDomain & ">;(&(objectCategory=" & "User" & ")" & _
 "(" & SearchField & "=" & SearchString & "));" & SearchField & "," & ReturnField & ";subtree"
 
' создаем набор записей RecordSet
 
Dim objRecordSet
 
Set objRecordSet = adoCommand.Execute
 
If objRecordSet.RecordCount = 0 Then
 
GetADInfo = "not found"  ' ничего не найдено
 
Else
 
GetADInfo = objRecordSet.Fields(ReturnField) ' возвращаемое значение
 
End If
 
' Закрываем подключение
 
objConnection.Close
 
' Очищаем переменные
 
Set objRecordSet = Nothing
 
Set objCommand = Nothing
 
Set objConnection = Nothing
 
End Function
Чтобы данная функция заработала, необходимо подключить ряд библиотек в VBA. В редакторе VBA выбираем меню Tools->References и в появившемся окне отмечаем следующие библиотеки:
Visual Basic For Application
Microsoft Excel 14.0 Object Library
OLE Automation
Microsoft Office 14.0 Object Library
Microsoft ActiveX Data Objects 2.8 Library (или около того)
Microsoft Scripting Runtime
Microsoft VBScript Regular Expressions 5.5

После того, как вы активируете следующие компоненты, сохраните макрос VBAи книгу Excel, и в результате в соответствующих полях Excel появится информация из Active Directory. Прелесть данного скрипта состоит в том, что он достаточно универсальный и с небольшими модификациями он поможет динамически получать практически любую информацию из Active Directory прямо в книге прямо в книге Excel!
Миниатюры
Active Directory - Получить список компьютеров из этой службы каталогов и вставить в таблицу Access  
2
2618 / 548 / 109
Регистрация: 21.03.2012
Сообщений: 1,051
26.06.2014, 20:44 3
minimen456, могу предложить ещё одну заготовку (метод тот же, что и в сообщении от korvindeson - запрос к Active Directory через ADO). Всё, что касается собственно Access, доделывайте самостоятельно, т.к. я с этим приложением не работаю.
Никаких дополнительных библиотек для работы примера к VBA-проекту подключать не требуется.
Предупреждаю, что работа заготовки в полном объёме не проверялась!
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

Sub Example()
Dim objDict As Object, strDomain As String, arrOUs() As String, strComputer As String
Dim strAttributes As String, strCommandText As String, strTemp As String, i As Integer, j As Integer
Dim objConnection As Object, objCommand As Object, objRSet As Object
Dim xValue, arrComputers(), arrProperties()
Const ADS_SCOPE_SUBTREE = 2
 
Set objDict = CreateObject("Scripting.Dictionary")
objDict.CompareMode = 1
strDomain = "dc=eur,dc=xxx,dc=com"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Sort On") = "cn"
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
strTemp = "ou=SMZ Workstations 7,ou=SMZ,ou=FRP,;ou=SMZ Workstations 7 Lite,ou=SMZ,ou=FRP,"
ReDim arrOUs(UBound(Split(strTemp, ";"))): arrOUs = Split(strTemp, ";")
strAttributes = "cn,description,whenCreated,whenChanged,lastLogonTimestamp,lastLogon"
For i = 0 To UBound(arrOUs)
    strCommandText = "SELECT " & strAttributes & " FROM 'LDAP://EURSMZ-HUB31/" & arrOUs(i) & strDomain & _
                        "' WHERE objectCategory='Computer'"
    objCommand.CommandText = strCommandText
    Set objRSet = objCommand.Execute
    objRSet.MoveFirst
    Do
        strComputer = objRSet.Fields("cn").Value
        objDict.Add strComputer, vbNullString
        For j = 1 To objRSet.Fields.Count - 1
            xValue = objRSet.Fields(j).Value
            If IsNull(xValue) Then xValue = vbNullString
            If LCase(TypeName(xValue)) = "string" Then
                objDict.Item(strComputer) = objDict.Item(strComputer) & xValue & ";"
            Else
                objDict.Item(strComputer) = objDict.Item(strComputer) & CStr(xValue) & ";"
            End If
        Next
        objRSet.MoveNext
    Loop While Not objRSet.EOF
Next
Set objRSet = Nothing
Set objCommand = Nothing
objConnection.Close
Set objConnection = Nothing
ReDim arrComputers(objDict.Count - 1): ReDim arrProperties(objDict.Count - 1)
arrComputers = objDict.Keys: arrProperties = objDict.Items
Set objDict = Nothing
'Теперь есть два массива типа Variant, каждый из которых содержит значения типа String.
'Порядок следования строк со значениями искомых атрибутов в массиве arrProperties()
'соответствует порядку следования строк с именами компьютеров в массиве arrComputers().
End Sub


Добавлено через 22 часа 25 минут
На досуге проверил свою заготовку, исправил ошибки, добавил некоторые проверки.
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

Sub Example()
Dim objWMI As Object, objItem As Object, dtmLastLogon As Date
Dim lngHigh As Long, lngLow As Long, lngBias As Long
Dim objDict As Object, strDomain As String, arrOUs() As String, arrNames() As String
Dim strAttributes As String, strCommandText As String, strComputer As String
Dim objConnection As Object, objCommand As Object, objRSet As Object
Dim strTemp As String, i As Integer, j As Integer, k As Integer
Dim arrComputers(), arrProperties()
Const ADS_SCOPE_SUBTREE = 2
 
On Error Resume Next
Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\EURSMZ-HUB31\root\CIMV2")
If Err.Number <> 0 Then
    Err.Clear
    Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\.\root\CIMV2")
    If Err.Number <> 0 Then Err.Clear
End If
On Error GoTo 0
If Not objWMI Is Nothing Then
    For Each objItem In objWMI.ExecQuery("SELECT Bias FROM Win32_TimeZone")
        lngBias = objItem.Bias
    Next
    Set objItem = Nothing: Set objWMI = Nothing
End If
Set objDict = CreateObject("Scripting.Dictionary")
objDict.CompareMode = 1
strDomain = "dc=eur,dc=xxx,dc=com"
strTemp = "ou=SMZ Workstations 7,ou=SMZ,ou=FRP,;ou=SMZ Workstations 7 Lite,ou=SMZ,ou=FRP,"
ReDim arrOUs(UBound(Split(strTemp, ";")))
If InStr(strTemp, ";") > 0 Then
    arrOUs = Split(strTemp, ";")
Else
    arrOUs(0) = strTemp
End If
strAttributes = "whenCreated,whenChanged,lastLogonTimeStamp,lastLogon,description,ADsPath"
ReDim arrNames(UBound(Split(strAttributes, ",")) - 1): k = -1
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Sort On") = "cn"
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
For i = 0 To UBound(arrOUs)
    strCommandText = "SELECT " & strAttributes & " FROM 'LDAP://EURSMZ-HUB31/" & arrOUs(i) & strDomain & _
                        "' WHERE objectCategory='Computer'"
    objCommand.CommandText = strCommandText
    Set objRSet = objCommand.Execute
    objRSet.MoveFirst
    Do
        Set objComputer = GetObject(objRSet.Fields("ADsPath").Value)
        strComputer = objComputer.cn
        objDict.Add strComputer, vbNullString
        For j = 0 To objRSet.Fields.Count - 1
            If LCase(objRSet.Fields(j).Name) <> "adspath" Then
                If k < UBound(arrNames) Then k = k + 1: arrNames(k) = objRSet.Fields(j).Name
                Select Case LCase(objRSet.Fields(j).Name)
                    Case "description": objDict.Item(strComputer) = objDict.Item(strComputer) & objRSet.Fields(j).Value & ";"
                    Case "whencreated", "whenchanged"
                        If IsNull(objComputer.LastLogin) Then
                            objDict.Item(strComputer) = objDict.Item(strComputer) & "неизвестно;"
                        Else
                            objDict.Item(strComputer) = objDict.Item(strComputer) & CStr(objRSet.Fields(j).Value) & ";"
                        End If
                    Case "lastlogon"
                        If IsNull(objComputer.LastLogin) Then
                            objDict.Item(strComputer) = objDict.Item(strComputer) & "неизвестно;"
                        Else
                            objDict.Item(strComputer) = objDict.Item(strComputer) & CStr(objComputer.LastLogin) & ";"
                        End If
                    Case "lastlogontimestamp"
                        If IsObject(objRSet.Fields(j).Value) Then
                            lngHigh = objRSet.Fields(j).Value.HighPart
                            lngLow = objRSet.Fields(j).Value.LowPart
                            If lngLow < 0 Then lngHigh = lngHigh + 1
                            If IsEmpty(lngBias) Then
                                dtmLastLogon = #1/1/1601# + ((4294967296# * lngHigh + lngLow) / 600000000) / 1440
                                objDict.Item(strComputer) = objDict.Item(strComputer) & CStr(dtmLastLogon) & " (время неточное);"
                            Else
                                dtmLastLogon = #1/1/1601# + ((4294967296# * lngHigh + lngLow) / 600000000 + lngBias) / 1440
                                objDict.Item(strComputer) = objDict.Item(strComputer) & CStr(dtmLastLogon) & ";"
                            End If
                        Else
                            objDict.Item(strComputer) = objDict.Item(strComputer) & "неизвестно;"
                        End If
                End Select
            End If
        Next
        objRSet.MoveNext
    Loop While Not objRSet.EOF
Next
Set objRSet = Nothing
Set objCommand = Nothing
objConnection.Close
Set objConnection = Nothing
ReDim arrComputers(objDict.Count - 1): ReDim arrProperties(objDict.Count - 1)
arrComputers = objDict.Keys: arrProperties = objDict.Items
'Теперь есть два массива типа Variant, каждый из которых содержит значения типа String.
'Порядок следования строк со значениями искомых атрибутов в массиве arrProperties()
'соответствует порядку следования строк с именами компьютеров в массиве arrComputers().
End Sub
2
1 / 1 / 0
Регистрация: 25.04.2014
Сообщений: 51
02.07.2014, 11:05  [ТС] 4
Спасибо Dmitrii, к сожалению, я не опытный VBA программист, и мне нужна помошь.
Visual Basic
1

Case "description": objDict.Item(strComputer) = objDict.Item(strComputer) & objRSet.Fields(j).Value & ";"
ошибка - type mismatched.
0
2618 / 548 / 109
Регистрация: 21.03.2012
Сообщений: 1,051
02.07.2014, 20:06 5
minimen456, замените весь фрагмент, расположенный между выражениями Select Case LCase(objRSet.Fields(j).Name) и End Select на такой:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

Case "description"
    If IsNull(objRSet.Fields(j).Value) Then
        objDict.Item(strComputer) = objDict.Item(strComputer) & ";"
    ElseIf IsArray(objRSet.Fields(j).Value) Then
        objDict.Item(strComputer) = objDict.Item(strComputer) & Join(objRSet.Fields(j).Value, " ") & ";"
    Else
        objDict.Item(strComputer) = objDict.Item(strComputer) & objRSet.Fields(j).Value & ";"
    End If
Case "whencreated", "whenchanged"
    If IsNull(objRSet.Fields(j).Value) Then
        objDict.Item(strComputer) = objDict.Item(strComputer) & "неизвестно;"
    Else
        objDict.Item(strComputer) = objDict.Item(strComputer) & CStr(objRSet.Fields(j).Value) & ";"
    End If
Case "lastlogon"
    If IsNull(objComputer.LastLogin) Then
        objDict.Item(strComputer) = objDict.Item(strComputer) & "неизвестно;"
    Else
        objDict.Item(strComputer) = objDict.Item(strComputer) & CStr(objComputer.LastLogin) & ";"
    End If
Case "lastlogontimestamp"
    If IsObject(objRSet.Fields(j).Value) Then
        lngHigh = objRSet.Fields(j).Value.HighPart
        lngLow = objRSet.Fields(j).Value.LowPart
        If lngLow < 0 Then lngHigh = lngHigh + 1
        If IsEmpty(lngBias) Then
            dtmLastLogon = #1/1/1601# + ((4294967296# * lngHigh + lngLow) / 600000000) / 1440
            objDict.Item(strComputer) = objDict.Item(strComputer) & CStr(dtmLastLogon) & " (время неточное);"
        Else
            dtmLastLogon = #1/1/1601# + ((4294967296# * lngHigh + lngLow) / 600000000 + lngBias) / 1440
            objDict.Item(strComputer) = objDict.Item(strComputer) & CStr(dtmLastLogon) & ";"
        End If
    Else
        objDict.Item(strComputer) = objDict.Item(strComputer) & "неизвестно;"
    End If
0
1047 / 531 / 66
Регистрация: 16.01.2013
Сообщений: 4,093
08.03.2016, 17:38 6
Dmitrii, можно Коментарии к коду?
0
08.03.2016, 17:38
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 08.03.2016, 17:38
Помогаю со студенческими работами здесь

Как настроить сервер в режиме контроллера домена и установить и настроить службы Active Directory (ADDS), DNS, DHCP ?
Здравствуйте, подскажите пожалуйста, выполняю лабораторную работу, и здесь стоят следующие задачи....

Как записать имя пользователя домена (active directory) в таблицу?
как записать имя пользователя домена (AD) в таблицу? допустим он добавляет текст, а чтобы понять...

Добавить пользователя в список групп Active Directory
Доброго дня! Подскажите, пожалуйста. Есть следующий код, который добавляет пользователя в группу в...

Получить информацию о пользователях из Active Directory
Всем привет! Вопрос в следующем. Может ли vb.net работать с доменом? На форме textbox, button,...

Как получить ФИО в Active Directory?
Всем привет! В нашей конторе развернута AD 2008 (более 1000 юзеров) От начальства поступила задачка...

Получить все группы текущего пользователя в Active Directory
Надо использовать AD, чтобы получить группы текущего пользователя. Показать данные о...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
6
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru