在vba中基于Alias Outlook搜索获取FirstName

Question

我可以通过以下代码进行反向操作(基于名称获取别名(：是否可以基于别名获取名称？(我想在excel电子表格中运行它(

Public Sub GetUsers()
Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")
Dim olNameSpace As Outlook.Namespace
    Set olNameSpace = olApp.GetNamespace("MAPI")
Dim olAddrList As Outlook.AddressList
    Set olAddrList = olNameSpace.AddressLists("Global Address List")
Dim oGal As Outlook.AddressEntries
    Set oGal = olAddrList.AddressEntries
Dim myAddrEntry As Outlook.AddressEntry
    Set myAddrEntry = olAddrList.AddressEntries("UserA")
Dim exchUser As Outlook.ExchangeUser
    Set exchUser = myAddrEntry.GetExchangeUser
MsgBox exchUser.Alias
End Sub

基于@Dmitry Streblechenko的建议。现在通过以下代码解决了问题：

Sub GetStaffName()
Dim str As String
    str = Sheets("Form").Range("StaffID").Value
Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")
Dim olNameSpace As Outlook.Namespace
    Set olNameSpace = olApp.GetNamespace("MAPI")
Dim olRecipient As Outlook.Recipient
    Set olRecipient = olNameSpace.CreateRecipient(str)
Dim oEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList

olRecipient.Resolve
If olRecipient.Resolved Then
    Select Case olRecipient.AddressEntry.AddressEntryUserType
        Case OlAddressEntryUserType.olExchangeUserAddressEntry
            Set oEU = olRecipient.AddressEntry.GetExchangeUser
                If Not (oEU Is Nothing) Then
                    Debug.Print oEU.PrimarySmtpAddress
                End If
            Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
                Set oEDL = olRecipient.AddressEntry.GetExchangeDistributionList
                    If Not (oEDL Is Nothing) Then
                        Debug.Print oEDL.PrimarySmtpAddress
                    End If
        End Select
    Sheets("Form").Range("StaffName").Value = oEU
End If
End Sub

Answer 1

您可以使用这个：

Public Function GetAliasFromName(sAddressEntry As String) As String
    With New Outlook.Application
        GetAliasFromName = .Session.AddressLists("Global Address List").AddressEntries(sAddressEntry).GetExchangeUser.Alias
    End With
End Function

Public Function GetNameFromAlias(sAlias As String) As String
    Dim oAddressEntry As Outlook.AddressEntry
    On Error Resume Next
    With New Outlook.Application
        For Each oAddressEntry In .Session.AddressLists("Global Address List").AddressEntries
            If oAddressEntry.Class = Outlook.OlObjectClass.olAddressEntry Then
                If oAddressEntry.GetExchangeUser.Alias = sAlias Then
                    GetNameFromAlias = oAddressEntry.Name
                    Exit For
                End If
            End If
        Next oAddressEntry
    End With
End Function

Answer 2

使用Namespace.CreateRecipient/Recipient.Resolve-它将能够解析登录别名或姓氏。

Answer 3

Public Function GetNameFromAlias2(sAlias As String) As String
    Dim oAddressEntry As Outlook.AddressEntry
    On Error Resume Next
    With New Outlook.Application
     For Each oAddressEntry In .Session.AddressLists("Global Address List").AddressEntries
      If oAddressEntry.Class = Outlook.OlObjectClass.olAddressEntry Then
       If oAddressEntry.GetExchangeUser.Alias = sAlias Then
        GetNameFromAlias2 = oAddressEntry.GetExchangeUser.Alias
        Exit For
       End If
      End If
     Next oAddressEntry
    End With
End Function

@Bas Verlaat，第一个功能运行顺利，但第二个正是我所需要的。然而，它没有给出正确的结果，我得到：01_New Requests在每个细胞上。