獲取姓名基於別名Outlook在VBA搜索

Question

我能夠通過以下代碼進行反向操作（基於名稱獲取別名）：是否可以根據別名獲取Name？ （我想運行它在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 - 這將是能夠爲登錄別名或最後都解決名稱。