从Active Directory提取信息

debugcn 发表于 Dev

JG7

我有两组数据，由于它们都不完整，因此有时需要交叉引用。我收到了来自HR的文件，其中包含员工的人口统计信息（包括他们的电子邮件地址）。我还可以访问从Active Directory中提取的Outlook联系人。有时我需要使用一个人的电子邮件地址来查找他们的网络“别名”，到目前为止，我一直在逐个查找人。

但是，我越来越需要引用此数据，有时我需要数百人作为别名。

有没有一种方法可以从Active Directory下载/查询此信息，以便可以在Excel中加入此数据？

编辑：我没有能力运行PowerShell脚本。

JG7

我在这里可以找到有关Stack Overflow的合适解决方案。我调整了要编译的数据，并最终将其作为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

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。