Get FirstName based on Alias Outlook search in vba

问题

I able to do reverse (Get Alias based on Name) by following code: Is it possible to get Name based on Alias ? (I would like to run it in excel spreadsheet)

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

Based on @Dmitry Streblechenko suggestion. Now problem resolved by following code:

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

回答1:

you can use this:

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

回答2:

Use Namespace.CreateRecipient / Recipient.Resolve - it will be able to resolve both a login alias or a last name.

回答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, the first function works smoothly, but the second is exactly what I need. However, it's not giving the correct result, I get: 01_New Requests on every cell.

来源：https://stackoverflow.com/questions/32943435/get-firstname-based-on-alias-outlook-search-in-vba

标签

vba

outlook