Récupérer adresses mails de la liste globale d'adresses Outlook [Résolu]

Signaler
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
-
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
-
Bonjour,

tout est dans le titre : j'ai un nom et un prénom, et je voudrais savoir si c'est possible de récupérer son adresse mail dans la liste d'adresses globale de mon Outlook depuis une base de données Access 2000, dans mon code VB.
J'ai bien trouvé ceci : http://www.vbfrance.com/codes/CARNET-ADRESSE-OUTLOOK-VERS-EXCEL-OFFICE-2003-VS_45694.aspx mais ça ne fonctionne qu'avec le dossier Contacts, peut-être y a-t-il un moyen de l'adapter pour accéder à la liste d'adresses globale ?
J'ai également trouvé ce lien : http://access.developpez.com/faq/?page=Outlook#outlcarnet mais par cette méthode, on ne peut à priori pas récupérer l'adresse mail...

Quelqu'un a une idée ?
Merci
A voir également:

12 réponses

Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
1
je suis trop contente !!!! J'ai trouvé, voilà la solution pour ceux qui galèrent :

Public Sub AfficherAdresses()


     Dim objSession As MAPI.Session
     Dim objField As MAPI.Field
     Dim v


     Set objSession = CreateObject("MAPI.Session")
     objSession.Logon "st31844"


     ' Récupération de la propriété PR_EMS_AB_PROXY_ADDRESSES
     Set objField = objSession.AddressLists("Liste d'adresses globale").AddressEntries.Item("nom prénom").Fields(CdoPR_EMS_AB_PROXY_ADDRESSES)


     ' ATTENTION : PR_EMS_AB_PROXY_ADDRESSES est une propriété multivaluée
      ' (PT_MV_TSTRING).
     For Each v In objField.Value
         If InStr(v, "@") <> 0 Then
            MsgBox Right(v, Len(v) - 5)
        End If
     Next


    Set objField = Nothing
    objSession.Logoff
    Set objSession = Nothing


End Sub
Par contre, je ne sais pas encore comment cette fonction réagit quand la personne qu'on cherche a des homonymes..Je reviendrai sûrement sur ce poste si je trouve..
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
1
ça y est j'ai tout trouvé, voilà la solution final pour ceux qui ont besoin.
D'abord je me sers des codes CDO que j'ai trouvé [www.cdolive.com/cdo10.htm ici].
Ensuite voici ma fonction, qui prend en paramètres le prénom et le nom de la personne à chercher dans Outlook :
Public Function ChercherContactOutlook(FirstName As String, _
                                        Name As String)
    'fonction qui cherche une personne dans Outlook à partir de son nom et son prénom
    'Si la personne n'existe pas ou s'il en existe plusieurs, la fonction renvoie "false"
    'Si la personne existe et qu'il n'y a pas d'ambiguité, la fonction renvoie la chaîne de caractères "pseudonyme;email;société"
   
    Dim objSession As MAPI.Session
    Dim objField As MAPI.Field
    Dim ol_adrEntries As MAPI.AddressEntries
    Dim ol_adrFilter As MAPI.AddressEntryFilter
    Const PR_EMAIL = &H39FE001E
    Const PR_PSEUDO = &H3A00001E
    Const PR_COMPANY_NAME = &H3A16001E
   
On Error GoTo ErrEnd



    Set objSession = CreateObject("MAPI.Session")
    objSession.Logon "TR40394"



    Set ol_adrEntries = objSession.AddressLists("Liste d'adresses globale").AddressEntries
    Set ol_adrFilter = ol_adrEntries.Filter
    ol_adrFilter.Name = Name & ", " & FirstName
    If ol_adrEntries.Count <> 1 Then
        'traitement plusieurs homonymes ou pas d'utilisateur correspondant à cette personne
        ChercherContactOutlook = "false"
    Else
        ChercherContactOutlook = ol_adrEntries.Item(1).Fields(PR_PSEUDO) & ";" & _
                                ol_adrEntries.Item(1).Fields(PR_EMAIL) & ";" & _
                                ol_adrEntries.Item(1).Fields(PR_COMPANY_NAME)
    End If



    Set objField = Nothing
    objSession.Logoff
    Set objSession = Nothing
    Set ol_adrEntries = Nothing
    Set ol_adrFilter = Nothing
    Exit Function
ErrEnd:
    MsgBox "Erreur N° " & Err.Number & vbLf & Err.Description, , Err.Source
End Function
Messages postés
577
Date d'inscription
vendredi 26 septembre 2008
Statut
Membre
Dernière intervention
20 novembre 2010
4
Bonjour

J'ai écrit la procédure ci-dessous en VBA Excel, mais je pense que tu n'auras aucune difficulté pour l'adapter pour Access.

Option Explicit
Sub liste_adresses_globales()
    Dim OutlookOlApp As Object
    Dim OutlookNameSpace As Namespace
    Dim nom As String, tabnom(1000) As String
    Dim ptr As Integer
    Dim adlst As AddressList
    Dim cnt1 As Integer
    Dim cnt2 As Integer
    Set OutlookOlApp = CreateObject("Outlook.Application")
    Set OutlookNameSpace = OutlookOlApp.GetNamespace("MAPI")
    cnt1 = 1
    Do Until LCase(OutlookNameSpace.AddressLists(cnt1)) = "liste d'adresses globale" _
        Or cnt1 = OutlookNameSpace.AddressLists.Count
        cnt1 = cnt1 + 1
    Loop
    Set adlst = OutlookNameSpace.AddressLists(cnt1)
    If Not LCase(OutlookNameSpace.AddressLists(cnt1)) = "liste d'adresses globale" Then
        MsgBox "L'application ne parvient pas à accéder à votre 'Liste d'adresses globales' outlook."
        Exit Sub
    End If
    cnt2 = adlst.AddressEntries.Count
    Application.ScreenUpdating = False          ' desactive la mise a jour de l'ecran
    For cnt1 = 1 To cnt2
        DoEvents
        Cells(cnt1, 1).Value = adlst.AddressEntries(cnt1)
    Next
    Application.ScreenUpdating = True           ' reactive la mise a jour de l'ecran
End Sub

Amicalement
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
Oroena t'a répondu


Voici u code a tourné dans Access.

Email= ChercherAdresseEmail(nom & prenom)

Private Function ResoudreAdresse(ByVal str_adresse As String, Optional obj_adresse As Outlook.AddressEntry) As String


Dim app_outlook As Outlook.Application
Dim obj_message As Outlook.MailItem
Dim obj_destinataire As Outlook.Recipient


Set app_outlook = New Outlook.Application
Set obj_message = app_outlook.CreateItem(olMailItem)
Set obj_destinataire = obj_message.Recipients.Add(str_adresse)
If Not obj_destinataire.Resolve Then
    ResoudreAdresse = ""
    Set obj_adresse = Nothing
Else
    ResoudreAdresse = obj_destinataire.Name
    Set obj_adresse = obj_destinataire.AddressEntry
End If
obj_message.Delete
   
End Function


Function ChercherAdresseEmail(str_contact As String) As String


Dim obj_adresse As Outlook.AddressEntry


If Len(ResoudreAdresse(str_contact, obj_adresse)) > 0 Then
    ChercherAdresseEmail = obj_adresse.Address
Else
    ChercherAdresseEmail = ""
End If


End Function
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
1
Bonjour,

merci pour ces réponses, je viens de tester les 2 codes mais ça me donne exactement le même résultat que le 2ème lien que j'ai donné, à savoir une chaîne de caractères "/o=xxxxx/ou=FR/cn=Recipients/cn=yyyyyyy". Je ne vois pas d'adresse mail, peut-être en manipulant 'Recipients' ?..Il doit bien y avoir un moyen de récupérer toutes les infos d'un utilisateur (mail, société, ville etc...) !
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
Essayer
ChercherAdresseEmail =obj_adresse.RecipAddress
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
1
test effectué --> message d'erreur "Propriété ou méthode non gérée par cet objet", ça doit être parce que j'utilise Access 2000..
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
Desole
On ne peut pas avoir linformation aussi simplement
Ce doit etre un pb de protection
Je crois que la recuperation de ladresse email  nest possible que via les contacts
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
1
Bonjour,

encore une autre piste avec ceci :
http://209.85.229.132/search?q=cache:_kFPYau5aTwJ:download.microsoft.com/download/6/2/7/627bd63a-fc8c-4862-80f2-5e8f5174edaf/cdo.doc+AfficherAdresses()+Dim+objSession+As+MAPI.Session&hl=fr&ct=clnk&cd=2&gl=fr
par contre, ce bout de code ouvre une fenêtre d'Outlook dans laquelle on choisit une liste d'adresses et une personne, et je suis une grosse quiche parce que je n'arrive pas à mettre par défaut la lise d'adresses globale et un nom en particulier, dans le code..Quelqu'un comprend-il ce bout de code ?
Je vais peut-être y arriver..
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
1
oups j'ai oublié de vous mettre ça dans le code :

Private Const CdoPR_EMS_AB_PROXY_ADDRESSES = &H800F101E
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
1
j'ai fait mon test avec un utilisateur qui a un homonyme dans la liste d'adresses globale, la ligne
Set objField = objSession.AddressLists("Liste d'adresses globale").AddressEntries.Item("nom prénom").Fields(CdoPR_EMS_AB_PROXY_ADDRESSES)
me renvoie la première personne qui a ce nom/prénom, et c'est tout, quelqu'un sait s'il y a moyen de savoir quand il y en a plusieurs ? Même question pour savoir si la personne n'existe pas, car pour le moment lorsque la personne n'existe pas ça me renvoie la première personne qui a ce nom de famille, tant pis pour le prénom, et ce n'est évidemment pas ce que je veux !
 
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
3 juin 2009
1
pfffffff désolée pour le lien vers les constantes CDO, ça n'a pas fonctionné comme je le voulais, voici le bon : www.cdolive.com/cdo10.htm