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

Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
- - Dernière réponse : kkhuet
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
- 5 mars 2009 à 13:27
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
Afficher la suite 

Votre réponse

12 réponses

Meilleure réponse
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
3
Merci
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..

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 96 internautes nous ont dit merci ce mois-ci

Commenter la réponse de kkhuet
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
1
Merci
ç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
Commenter la réponse de kkhuet
Messages postés
578
Date d'inscription
vendredi 26 septembre 2008
Dernière intervention
20 novembre 2010
0
Merci
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
Commenter la réponse de cs_Orohena
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Dernière intervention
2 juin 2016
0
Merci
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
Commenter la réponse de cs_loulou69
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
0
Merci
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...) !
Commenter la réponse de kkhuet
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Dernière intervention
2 juin 2016
0
Merci
Essayer
ChercherAdresseEmail =obj_adresse.RecipAddress
Commenter la réponse de cs_loulou69
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
0
Merci
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..
Commenter la réponse de kkhuet
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Dernière intervention
2 juin 2016
0
Merci
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
Commenter la réponse de cs_loulou69
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
0
Merci
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..
Commenter la réponse de kkhuet
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
0
Merci
oups j'ai oublié de vous mettre ça dans le code :

Private Const CdoPR_EMS_AB_PROXY_ADDRESSES = &H800F101E
Commenter la réponse de kkhuet
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
0
Merci
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 !
 
Commenter la réponse de kkhuet
Messages postés
92
Date d'inscription
lundi 16 mai 2005
Dernière intervention
3 juin 2009
0
Merci
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
Commenter la réponse de kkhuet

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.