Puxar informações do Active Directory

Question

Eu tenho dois conjuntos de dados que ocasionalmente preciso fazer referência cruzada, pois nenhum deles está completo. Eu recebo um arquivo do RH que inclui informações demográficas para funcionários (incluindo seu endereço de e-mail). Eu também tenho acesso aos contatos do Outlook sendo extraídos do Active Directory. Às vezes, tenho a necessidade de usar o endereço de e-mail de uma pessoa para encontrar seu "alias" de rede e, até esse momento, tenho procurado pessoas individualmente.

No entanto, minha necessidade de fazer referência a esses dados está aumentando e às vezes tenho centenas de pessoas para as quais preciso pegar um alias.

Existe uma maneira de baixar / consultar essas informações do Active Directory para que eu possa juntar esses dados no Excel?

EDIT: Eu não tenho a capacidade de executar um script do PowerShell.

    

Answer 1

Consegui encontrar uma solução adequada no Stack Overflow aqui. Eu ajustei os dados sendo compilados e acabei com isso como meu sub final no 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