Récupération contacts multiples dans la GAL via outlook

Bonjour à tous,

Actuellement en cours de DEV sur access, j'aurai besoin de pourvoir récupérer des données d'utilisateurs.
Grâce à mes recherches sur ce forum et autre, j'ai pu faire fonctionner ce code qui répond en très grande partie à mon besoin.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Sub contacts_V2()   Dim olApp As Outlook.Application Dim ola As Outlook.AddressEntries Dim ole As Outlook.AddressEntry   Set olApp = GetObject("", "Outlook.Application") Set ola = olApp.Session.GetGlobalAddressList().AddressEntries   Set ole = ola.Item("Prenom NOM") Debug.Print ole.GetExchangeUser().Alias Debug.Print ole.GetExchangeUser().PrimarySmtpAddress   End Sub

---

J'ai maintenant une question que je n'arrive pas à résoudre:
Il arrive que dans la GAL, il y ai plusieurs entrées avec le même "Nom Prénom". Dans ce cas, ce code renvoie la première occurrence trouvée mais pas forcément la bonne.
Comment puis-je faire pour renvoyer tous les enregistrements correspondants et ce afin de pouvoir demander quelles données enregistrer en base à l'utilisateur?

La GAL de mon entreprise étant très grosse environ 101000 objets. J'ai tenté de la parcourir mais cela est vraiment trop long. C'est pourquoi je cherche une façon plus rapide.
Lorsque l'on utilise l'interface de recherche d'outlook c'est très rapide d'où mon interrogation.

Vous remerciant par avance pour votre aide.

Bonjour,

Ta macro renvoi le premier nom trouvé (ou proche s'il n'existe pas), et apparemment Outlook ne permet pas de trouver tous les items ayant la même nom directement .
voir ici

Il faut boucler sur toutes les lignes, l'astuce est peut être de charger en mémoire le GAL, et ensuite de l'interroger :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

Public monTablo() Public olApp As Outlook.Application Public ola As Outlook.AddressEntries   Sub Chargement_MonTablo() Set olApp = GetObject("", "Outlook.Application") Set ola = olApp.Session.GetGlobalAddressList().AddressEntries ReDim monTablo(1, ola.Count)   For i = 1 To ola.Count monTablo(0, i) = i monTablo(1, i) = ola(i).Name Next i End Sub   Sub contacts_V3() Dim ole As Outlook.AddressEntry If ola Is Nothing Or IsEmpty(monTablo) Then Chargement_MonTablo     For i = 1 To ola.Count   If monTablo(1, i) = "Virginie LEGRAND" Then Set ole = ola.Item(monTablo(0, i)) Debug.Print ole.Name & vbTab & ole.GetExchangeUser().Alias & vbTab & ole.GetExchangeUser().PrimarySmtpAddress End If Next   End Sub

---