excel - Find an email address from an exchange user in Outlook when multiple user exist with the same first and last name - Stac

admin管理员组

文章数量:1384278

I usually use the function suggested here (VBA-Excel How to find an email address from an exchange user in Outlook), but in our company there exist many omonimous user

so , for those, first and second name is the same, but (of course) they have different email, userid, etc...

when I resolve my name (e.g. "Pinco Pallino") , in case multiple "Pinco Pallino" does exist, myRecipient.Resolved return false (an no one result is given)

can you suggest me a way to have (let me say) an array as a result of the funztion with one (or all) the user(s) found ?

thanks

Code from the link:

Function lookupEmail(name)
    lookupEmail = ""
    Dim objApp As New Outlook.Application
    Dim myNamespace As Outlook.Namespace
    Dim myRecipient As Outlook.recipient
    
    Set myNamespace = objApp.GetNamespace("MAPI")
    Set myRecipient = myNamespace.CreateRecipient(name)
    
    myRecipient.Resolve
    If myRecipient.Resolved Then
        lookupEmail = GetSMTPAdress(myRecipient)
 
    End If
End Function

Function GetSMTPAdress(recipient As Outlook.recipient)
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
        ";
     Set pa = recipient.PropertyAccessor
     GetSMTPAdress = pa.GetProperty(PR_SMTP_ADDRESS)
End Function

I usually use the function suggested here (VBA-Excel How to find an email address from an exchange user in Outlook), but in our company there exist many omonimous user

so , for those, first and second name is the same, but (of course) they have different email, userid, etc...

when I resolve my name (e.g. "Pinco Pallino") , in case multiple "Pinco Pallino" does exist, myRecipient.Resolved return false (an no one result is given)

can you suggest me a way to have (let me say) an array as a result of the funztion with one (or all) the user(s) found ?

thanks

Code from the link:

Function lookupEmail(name)
    lookupEmail = ""
    Dim objApp As New Outlook.Application
    Dim myNamespace As Outlook.Namespace
    Dim myRecipient As Outlook.recipient
    
    Set myNamespace = objApp.GetNamespace("MAPI")
    Set myRecipient = myNamespace.CreateRecipient(name)
    
    myRecipient.Resolve
    If myRecipient.Resolved Then
        lookupEmail = GetSMTPAdress(myRecipient)
 
    End If
End Function

Function GetSMTPAdress(recipient As Outlook.recipient)
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft/mapi/proptag/0x39FE001E"
     Set pa = recipient.PropertyAccessor
     GetSMTPAdress = pa.GetProperty(PR_SMTP_ADDRESS)
End Function

• excel
• vba
• outlook

Share Improve this question Follow edited Mar 18 at 14:49 Dmitry Streblechenko 66.5k44 gold badges5555 silver badges8383 bronze badges asked Mar 18 at 14:43 user1653963user1653963 1133 bronze badges

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 1

Outlook Object Model won't let you search for multiple matches: it either finds a unique match, or returns an error if no matches are found or if more than one march exists.

On the Extended MAPI level (C++ or Delphi only) you can create a PR_ANR restriction on the contents table of a particular search container (such as GAL). That is what Outlook does when it resolves a name you typed in the To/CC/BCC edit boxes - it goes through all containers in the search path and applies the PR_ANR restriction. If there are multiple matches found, it displays a dialog box with the list. If there is a single match, it is returned and the search is stopped, otherwise it continues to the next container in the search path.

If using Redemption (I am its author - any language) is an option, it exposes RDOAddressBook.ResolveNameEx and RDOAddressList.ResolveNameEx, which return a list of matches.

In VB script:

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

本文标签：