Get PrimarySMTP using GetExchangeUser

In Excel version 2201, using VBA, I would like to get the PrimarySMTP property for a list of mail users for which I have the display name.

I have written code that works in most cases:

Set myolApp = CreateObject("Outlook.Application") 

Set myNameSpace = myolApp.GetNamespace("MAPI") 

Set MyAddrList = myNameSpace.addressLists("Global Address List") 

Set myAddrEntries = MyAddrList.AddressEntries(strDisplayname) 

Set objExchUsr = myAddrEntries.GetExchangeUser 

PrimarySMTP=objExchUsr.PrimarySMTPAddress

The problem arises when sometimes for a display name there is more than one result: GetExchangeUser does not retrieve the PrimarySMTP of the correct person.

I tried passing to the AddressEntries function the UPN, instead of the Display Name, but with no success.

Solution

If the recipient name is ambiguous, Recipient.Resolve will fail.

You cannot resolve ambiguous names using Outlook Object Model - you can loop through all GAL entries, but that will be too slow and will fail for large GAL containers.

In Extended MAPI (C++ or Delphi), you can use PR_ANR restriction to get all matches (that is what Outlook uses to show the list of ambiguous entries).

If using Redemption (I am its author) is an option, you can use RDOSession.AddressBook.GAL.ResolveNameEx

  set Session = CreateObject("Redemption.RDOSession")
  Session.MAPIOBJECT = myolApp.Session.MAPIOBJECT
  set AdrrEntries = Session.AddressBook.GAL.ResolveNameEx(strDisplayname)
  Debug.Print AdrrEntries.Count & " names were returned by ResolveNameEx:"
  Debug.Print "------------"
  for each AE in AdrrEntries
    Debug.Print AE.Name
  next
  Debug.Print "------------"