Извлечь информацию из Active Directory

Question

У меня есть два набора данных, которые мне иногда нужны для перекрестных ссылок, поскольку ни один из них не является полным. Я получаю файл от HR, который включает демографическую информацию для сотрудников (включая их адрес электронной почты). У меня также есть доступ к контактам Outlook, извлекаемым из Active Directory. Иногда мне нужно использовать адрес электронной почты человека, чтобы найти "псевдоним" в сети, и до этого момента я искал людей в индивидуальном порядке.

Тем не менее, моя потребность ссылаться на эти данные растет, и у меня иногда есть сотни людей, для которых мне нужно получить псевдоним.

Есть ли способ загрузить / запросить эту информацию из Active Directory, чтобы я мог присоединиться к этим данным в Excel?

РЕДАКТИРОВАТЬ: У меня нет возможности запустить скрипт PowerShell.

Answer 1

Мне удалось найти подходящее решение по переполнению стека здесь. Я настроил скомпилированные данные и закончил с этим как мой последний саб в Excel.

Sub GALExport()

Dim appOL As Object
Dim oGAL As Object
Dim oContact As Object
Dim oUser As Object
Dim arrUsers(1 To 65000, 1 To 5) As String
Dim UserIndex As Long
Dim i As Long

Set appOL = CreateObject("Outlook.Application")
Set oGAL = appOL.GetNameSpace("MAPI").AddressLists("Global Address List").AddressEntries

For i = 1 To oGAL.Count
    Set oContact = oGAL.Item(i)
    If oContact.AddressEntryUserType = 0 Then
        Set oUser = oContact.GetExchangeUser
        If Len(oUser.lastname) > 0 Then
            UserIndex = UserIndex + 1
            arrUsers(UserIndex, 1) = oUser.Name
            arrUsers(UserIndex, 2) = oUser.PrimarySMTPAddress
            arrUsers(UserIndex, 3) = oUser.Alias
            arrUsers(UserIndex, 4) = oUser.JobTitle
            arrUsers(UserIndex, 5) = oUser.Department
        End If
    End If
Next i

appOL.Quit

Range("A1").Value = "Name"
Range("B1").Value = "Email Address"
Range("C1").Value = "Network Alias"
Range("D1").Value = "Job Title"
Range("E1").Value = "Department"

If UserIndex > 0 Then
    Range("A2").Resize(UserIndex, UBound(arrUsers, 2)).Value = arrUsers
End If

Set appOL = Nothing
Set oGAL = Nothing
Set oContact = Nothing
Set oUser = Nothing
Erase arrUsers

End Sub