LDAP catalog VBA parser

С помощью VBA можно посмотреть информацию и контакты в сети пользователей:

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

Ячейка B2 (наименование организации):
=GetADInfo("samAccountName";A2; "Company")
Ячейка C2 (CN):
=GetADInfo("samAccountName";A2; "distinguishedName")
также вместо "Company" можно подставить "name" чтобы получить учетку или "mail" чтобы получить почтовый ящик пользователя
ОБЯЗАТЕЛЬНО чтобы эта бяка работала надо в References добавить  Microsoft VBScript Regular Expressions 5.5