基于别名Excel VBA检索Outlook详细信息

我有组织中所有员工的员工ID列表。我希望Excel VBA代码能够获得诸如名字、姓氏、指定联系人和部门等详细信息

别名是员工ID。因此代码应将员工ID作为别名，并在Outlook中搜索上述各个详细信息

我在网上找到了一个宏，并根据我的要求对其进行了修改：

Sub tgr()

Dim appOL As Object
Dim oGAL As Object
Dim oContact As Object
Dim oUser As Object
Dim UserIndex As Long
Dim i As Long
Dim j As Integer

Set appOL = CreateObject("Outlook.Application")
Set oGAL = appOL.GetNamespace("MAPI").AddressLists("/Name of the Distribution List/").AddressEntries

On Error Resume Next

For j = 2 To Application.WorksheetFunction.CountA(Columns(1))

    For i = 1 To oGAL.Count

        Set oContact = oGAL.Item(i)

        If oContact.AddressEntryUserType = 0 Then

            Set oUser = oContact.GetExchangeUser

            If UCase(oUser.FirstName) = UCase(Range("A" & j).Value) And UCase(oUser.LastName) = UCase(Range("B" & j).Value) Then

                Range("c" & j).Value = oUser.Alias

                Range("D" & j).Value = oUser.JobTitle

                Range("E" & j).Value = oUser.Department

                Range("F" & j).Value = oUser.ManagerName

                i = oGAL.Count
            End If
        End If       
    Next i
Next j

Set oGAL = Nothing
Set oContact = Nothing
Set oUser = Nothing

End Sub

代码可以工作，但问题是它每次都会检查addresslist中的所有项目以搜索每个项目。这需要更多的时间

---

有没有一种方法可以通过广泛搜索来简化它，而不是查看地址列表中的每个项目并进行比较。类似Addresslist.find的东西。只有在联系人文件夹中搜索地址列表时，属性“查找”才有效。

过去，我在Excel中使用ADSI VBScript或ADO+VBA从域而不是Outlook中查找这些详细信息。例如：

Dim adoConnection As ADODB.Connection
Set adoConnection = New ADODB.Connection
With adoConnection
    .Provider = "ADsDSOObject"
    .CursorLocation = adUseClient
    .Open "Active Directory Provider"
End With

Dim adoCommandText As String
adoCommandText = "<LDAP://DC=company, DC=co, DC=uk>" & _
"; (& (objectCategory=person) (mail=" & EmailAddress & ")); " & _
"sAMAccountName, cn, givenName; subtree")

Dim adoCommand As ADODB.Command
Dim adoReturnRecordset As ADODB.Recordset

Set adoCommand = New ADODB.Command
With adoCommand
    .ActiveConnection = adoConnection
    .CommandType = adCmdText
    .CommandText = adoCommandText

    Set adoReturnRecordset = .Execute
End With

' read the data returned by using ADQueryReturnRecordset.Fields(0) etc.

Dim ADODB.Connection作为ADODB.Connection
Set adoConnection=New ADODB.Connection
有联系
.Provider=“ADsDSOObject”
.CursorLocation=adUseClient
.打开“Active Directory提供程序”
以
将文本设置为字符串
adoCommandText=”“&_
“；（&（objectCategory=person）（mail=“&EmailAddress&”）；”&”_
“sAMAccountName，cn，givenName；子树”）
Dim ADODB.Command作为ADODB.Command
将adoReturnRecordset设置为ADODB.Recordset
Set adoCommand=New ADODB.Command
带着命令
.ActiveConnection=adoConnection
.CommandType=adCmdText
.CommandText=adomandText
Set adoReturnRecordset=.Execute
以
'读取使用ADQueryReturnRecordset.Fields（0）等返回的数据。

如果您完全确定需要从VBA中执行ADO路由，则该页面可以帮助您开始使用ADO路由

---

然而，现在我们已经到了2015年，我建议您考虑使用powershell，它可以从Active Directory（&Exchange）查找详细信息，作为使用VBA的替代方案。是否有任何原因（1）您需要为此使用VBA，以及（2）为什么要从Outlook而不是AD/Exchange中查找这些详细信息？

别名与Windows登录别名相同？请尝试Namespace.ResolveName-GAL提供程序将根据登录别名进行解析。

从

全局地址列表

或可从Outlook或AD访问的联系人文件夹中提取详细信息？您需要在联系人/广告中指定员工ID的关联方式。如果您尝试了一些编码来实现，我们将不胜感激。目前尚不清楚您需要在何处搜索联系人…感谢您的快速回复。不幸的是，我希望代码在没有外部电子邮件访问的工作场所工作。所以我不能得到密码。我只需要一个简单的代码，使用别名搜索GAL，当找到结果时，检索名字、姓氏、职务、部门和经理。我知道这要求太高了，但我一直在想办法做到这一点。我在网上发现了一些代码，但它们都是使用别名以外的所有其他字段进行搜索的。按照PatricK当时的建议，沿着Outlook和GAL路线走下去，似乎有一个完整的示例代码用于您的场景，请访问“谢谢您的帮助”。在编码方面我不如你。VBA似乎是一种简单的编码方式，因为我对编码是新手。但我真的很感谢你的帮助。那么，有没有一种方法可以在vba中执行此操作以在GAL中搜索