Get primarySMTP programmatically using getExchangeUser-CodePudding

In an Excel (version 2201) macro 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 some code that works in most of the 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: the getexchangeuser function does not retrieve the primarysmtp of the correct person.

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

Does anybody have an idea?

CodePudding user response：

Use the NameSpace.CreateRecipient method which creates a Recipient object. It is used to verify a given name against an address book. The name of the recipient can be a string representing the display name, the alias, or the full SMTP email address of the recipient.

Sub ResolveName() 
 Dim myNamespace As Outlook.NameSpace
 Dim myRecipient As Outlook.Recipient
 Dim CalendarFolder As Outlook.Folder
 
 Set myNamespace = Application.GetNamespace("MAPI")
 Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev")
 myRecipient.Resolve 
 If myRecipient.Resolved Then    
   Set objExchUsr = myRecipient.AddressEntry.GetExchangeUser()
   PrimarySMTP = objExchUsr.PrimarySMTPAddress
 End If 
End Sub

CodePudding user response：

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 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 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 "------------"