VBA Outlook Global Address Book Returns First Entry

Question

I am using VBA to open the Outlook/Exchange global address list Dialog, select one or more people, then do some processing with each person. The following is an example of the code:

Dim objApp As New Outlook.Application
Dim objDialog As SelectNamesDialog
Dim objGAL As AddressList
Dim objAddrEntry As AddressEntry
Dim objExchUser As Outlook.ExchangeUser
Dim strAliasName As String

Set objDialog = objApp.Session.GetSelectNamesDialog
Set objGAL = objApp.GetNamespace("MAPI").AddressLists("Global Address List")
With objDialog
    .AllowMultipleSelection = True
    .InitialAddressList = objGAL
    .ShowOnlyInitialAddressList = True
    If .Display Then
        Dim objSelection As Outlook.Recipient
        For Each objSelection In .Recipients
            strAliasName = objSelection.AddressEntry
            Set objAddrEntry = objGAL.AddressEntries(strAliasName)
            Set objExchUser = objAddrEntry.GetExchangeUser
            If Not objExchUser Is Nothing Then
                'Do some processing with exchange user information
                Debug.Print objExchUser.PrimarySmtpAddress
            End If
        Next
    End If
End With

The problem: If there is more than one person with the same Exchange alias (this is for a large company where duplicate aliases are common) - e.g. 3 people with the alias of "Doe, John" - the GetSelectNamesDialog returns Exchange information for the FIRST person in the group and not necessarily the person who was selected.

I have tried looking at the different properties available for .Recipients, .AddressEntry, etc. and cannot find any others that return something besides .AddressEntry and .Name. And therein lies the problem.

Answer 1

There is absolutely no reason to retrieve address entry by its name if you already have a perfectly good AddressEntry object.

The lines

strAliasName = objSelection.AddressEntry
set objAddrEntry = objGAL.AddressEntries(strAliasName)

need to be replaced with

Set objAddrEntry = objSelection.AddressEntry

Answer 2

You can iterate over all selected recipients in the dialog and check their aliases as well as other information:

Dim objSelection As Outlook.Recipient
For Each objSelection In .Recipients
  objAddrEntry = objSelection.AddressEntry
  Set objExchUser = objAddrEntry.GetExchangeUser
  If Not objExchUser Is Nothing Then
     'Do some processing with exchange user information
      Debug.Print objExchUser.PrimarySmtpAddress
      Debug.Print objExchUser.Alias
  End If
Next

The Recipient.AddressEntry property returns the AddressEntry object corresponding to the resolved recipient, not a string.