Obtenir des détails de contact Outlook à partir de Contact dans la liste de distribution

Question

Puisqu'il n'est pas possible d'utiliser une liste de distribution d'Outlook pour créer des lettres types (il n'est pas possible de sélectionner ces listes), je voudrais lire les informations de contact des contacts dans une liste de distribution. Selon les API, il devrait être possible d'obtenir l'élément ContactItem ou de lire la propriété avec l'accesseur de propriété.

Les deux ne fonctionnent pas. Un moyen facile serait de lire uniquement le nom du contact (ce que je peux lire à partir de AddressEntry) et de rechercher dans le carnet d'adresses Outlook. Mais je pense que c'est lourd et pourrait être sujet à erreur.

Voir mon code de test ci-dessous. Les deux, GetContact() et GetProperty() ne fonctionnent pas.

Existe-t-il un autre moyen d'obtenir les coordonnées telles que le prénom, l'adresse professionnelle, etc.?

Option Explicit 

Sub test() 
Dim myOlExp As Outlook.Explorer 
Dim myOlSel As Outlook.Selection 
Dim myOlDistList As Outlook.DistListItem 
Dim nrListItems As Integer 
Dim myRecipient As Outlook.Recipient 
Dim myAddressEntry As Outlook.AddressEntry 
Dim myContactItem As Outlook.ContactItem 
Dim myPropertyAccessor As Outlook.propertyAccessor 
Dim givenName As String 

Set myOlExp = Application.ActiveExplorer 
Set myOlSel = myOlExp.Selection 
Set myOlDistList = myOlSel.Item(1) 
For nrListItems = 1 To myOlDistList.MemberCount 
    Set myRecipient = myOlDistList.GetMember(nrListItems) 
    Set myAddressEntry = myRecipient.AddressEntry 
    ' does not work 
    Set myContactItem = myAddressEntry.GetContact 

    Set myPropertyAccessor = myAddressEntry.propertyAccessor 
    ' does also not work 
    givenName = myPropertyAccessor.GetProperty("urn:schemas:contacts:givenName") 
Next nrListItems 
End Sub 

Answer 1

Oui, il s'agit d'un problème dans le modèle objet Outlook. Je ne suis pas au courant d'une solution de contournement de l'utilisation Redemption

Dim myOlExp As Outlook.Explorer 
Dim myOlSel As Outlook.Selection 
Dim Session As Redemption.RDOSession 
Dim myOlDistList As Redemption.RDODistListItem 
Dim nrListItems As Integer 
Dim myAddressEntry As Redemption.RDOAddressEntry 

     set Session = CreateObject("Redemption.RDOSession") 
     Session.MAPIOBJECT = Application.Session.MAPIOBJECT 
     set myOlDistList = Session.GetMessageFromID(Application.ActiveExplorer.Selection(1).EntryID) 
     For nrListItems = 1 To myOlDistList.MemberCount 
     Set myAddressEntry = myOlDistList.GetMember(nrListItems) 
     Set myContactItem = myAddressEntry.GetContact 
     MsgBox myContactItem.FirstName 
     next