根据别名检索 Outlook 详细信息 Excel VBA

Retrieve Outlook details based on alias name Excel VBA

我有一个组织中所有员工的员工 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.find。好吧,只有在联系人文件夹中搜索地址列表没有 FIND 属性.

时,propety find 才有效

过去,我在 Excel 中使用 ADSI VBScripts 或 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.

如果您完全确定这需要在 VBA 内完成,https://msdn.microsoft.com/en-us/library/ms810638.aspx 页面可以帮助您开始使用 ADO 路线。

但是,现在是 2015 年,我建议可能会考虑使用 powershell,它可以从 Active Directory(和 Exchange)中查找详细信息,作为使用 VBA 的替代方法。是否有任何原因 (1) 您需要为此使用 VBA 以及 (2) 为什么您要从 Outlook 而不是 AD/Exchange 查找这些详细信息?

Windows 登录别名中的别名?尝试 Namespace.ResolveName - GAL 提供商将根据登录别名进行解析。