Question

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

别名是Employee ID。因此，代码应将Employee 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这样的东西。那么propety find只有在联系人文件夹中搜索地址列表时才有效。没有FIND属性。

Answer 1

过去，我在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.

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

但是，现在我们在2015年，我建议可能会查看powershell，它可以从Active Directory（＆amp; Exchange）查找详细信息，作为使用VBA的替代方案。是否有任何理由（1）您需要使用VBA，以及（2）为什么要从Outlook而不是AD / Exchange查找这些详细信息？

Answer 2

Windows登录别名中的别名？尝试Namespace.ResolveName - GAL提供程序将根据登录别名解析。

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

2 个答案: