Question

在Outlook中查看某人的联系人卡时，Office中有一个字段可以显示其位置。如何使用VBA找到它？这是我最实用的代码：

Private Function getLocation(username As String) As String
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olGAL As Outlook.AddressEntries
Dim olAddressEntry As Outlook.AddressEntry
Dim olUser As Outlook.ExchangeUser

Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olGAL = olNS.AddressLists("Global Address List").AddressEntries
Set olAddressEntry = olGAL.Item(username)
Set olUser = olAddressEntry.GetExchangeUser
Debug.Print olGAL.Count 'count is 646718
Debug.Print olUser.OfficeLocation
Debug.Print olUser.Address
Debug.Print olUser.Name

getLocation = olUser.OfficeLocation

Set olApp = Nothing
Set olNS = Nothing
Set olGAL = Nothing
Set olAddressEntry = Nothing
Set olUser = Nothing

End Function

当我搜索他们的实际名字（EG，John Smith）时，这是有效的，但它只返回第一个John Smith。如何使用他们的电子邮件地址或别名进行搜索？

注意：我添加了对Microsoft Outlook 16.0 Object Library的引用以利用Intellisense，但我计划在它工作后切换到后期绑定。

Answer 1

因此，我还没有找到通过电子邮件或别名查询Exchange的方法，因为.Item方法（来自行olGAL.Item(username)）需要Either the index number of the object, or a value used to match the default property of an object in the collection。我找到了确保获得正确用户的方法。 GAL的默认属性是用户的名称，在我的情况下（但可能不是每个人的情况......都找不到好的文档来验证这一点）Active中的DistinguishedName目录。因此，如果我使用用户的SAM帐户搜索AD，我就可以获得用户的DN。然后，我可以使用该DN搜索Exchange，以确保我拥有正确的＆＃34; John Smith＆＃34;。

这是我的组合代码：

'I pass the username (EG: johnsmit) and get the DN (eg John Smith - VP of Sales).
' This DN gets passed to the function in my question, and returns the correct location.
Private Function GetFullName(strUsername As String) As String
        Dim objConnection  As Object
        Dim objCommand As Object
        Dim objRecordSet As Object
        Dim strDN As String
        Dim temp As Variant

        Const ADS_SCOPE_SUBTREE = 2

        Set objConnection = CreateObject("ADODB.Connection")
        Set objCommand = CreateObject("ADODB.Command")
        objConnection.Provider = "ADsDSOObject"
        objConnection.Open "Active Directory Provider"
        Set objCommand.ActiveConnection = objConnection

        objCommand.Properties("Page Size") = 1000
        objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

        objCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://dc=mydomain,dc=com' WHERE objectCategory='user' AND sAMAccountName='" & strUsername & "'"
        Set objRecordSet = objCommand.Execute

        objRecordSet.MoveFirst
        Do Until objRecordSet.EOF
            strDN = objRecordSet.Fields("distinguishedName").Value
            temp = Split(strDN, ",")
            GetFullName = Replace(temp(0), "CN=", "")
            objRecordSet.MoveNext
        Loop

        objConnection.Close
        Set objConnection = Nothing
        Set objCommand = Nothing
        Set objRecordSet = Nothing
End Function

如果有人有更好，更快，更便宜（没有点击AD服务器的方法）的方法，我很乐意听到它。

在VBA

1 个答案: