Importer email client a partir d'outlook 2010

[kyliann]

Bonjour le forum,

Je viens a nouveau vers vous pour une petite aide concernant l'importation des adresse mail de clients.

j'ai bien trouvé un modele de BOISGONTIER qui recherche les mails a partir des noms prénoms.

Outlook est un service courrier d'une entreprise ( exchange) .

Le code que j'ai va bien rechercher les adresses mail mais uniquement dans les contacts personnels de mon compte.

Est il possible que la recherche se face dans la liste globale de l'entreprise et nom dans mes contacts ?

Le code dont je me suis servi !

Sub LectureContacts()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olfFolder = olns.GetDefaultFolder(10)
ligne = 2
On Error Resume Next ' contacts incomplets
For Each i In olfFolder.Items
Cells(ligne, 1) = i.FirstName
Cells(ligne, 2) = i.LastName
Cells(ligne, 3) = i.Email1Address
Cells(ligne, 4) = i.Categories
ligne = ligne + 1
Next i
On Error GoTo 0
[A1].Sort Key1:=[A1], Header:=xlYes
End Sub

Sub AjoutContact()
Set olApp = CreateObject("Outlook.Application")
Set olItem = olApp.CreateItem(2)
With olItem
.FirstName = "zzzzz"
.LastName = "zzzzz"
.Email1Address = "zzzzz@hotmail.com"
.HomeAddressCity = "Montigny"
.Categories = "Professionnel, Personnel"
.Save
End With
End Sub

Je vous remercie d'avance pour votre aide

Kyliann

 

[kyliann]

Re : Importer email client a partir d'outlook 2010

bonjour David84, le fil, le forum

Le plus simple est de placer un fichier exemple avec juste l'userform et son code et si besoin quelques données pour faire fonctionner ta macro.

Merci de ta réponse.

je suis un peu débordé en ce moment..!!!

Je te prépare cela dans la soirée et je te l'envoie.

si on ne peux pas ouvrir le carnet d'adresse j'ai peu etre une autre solution c'est de mettre le fichier annuaire dans un répertoire annexe.

encore merci pour ton aide

@@++ Kyliann

 

[david84]

Re : Importer email client a partir d'outlook 2010

est il possible par macro sur mon USF d'ouvrir outlook et cette fenetre de contact ( directement sur liste globale)

...si on ne peux pas ouvrir le carnet d'adresse...

Tu parles d'afficher le carnet d'adresses ou la liste d'adresses globales ?
Les 2 procédures sont différentes.
Pour afficher le carnet d'adresses :

'cocher Microsoft Outlook xx Object Library
Sub Afficher_carnetAdresses()
Dim olApp As Outlook.Application
Dim NSpace As Namespace
Dim ContactFolder As Folder

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
  Set olApp = New Outlook.Application
  Err.Clear
End If

Set NSpace = olApp.GetNamespace("MAPI")
Set ContactFolder = NSpace.GetDefaultFolder(olFolderContacts)
ContactFolder.Display
End Sub

Pour afficher la liste d'adresses globale :

'cocher Microsoft Outlook xx Object Library
Sub Afficher_Liste_adresses_globale()
Dim olApp As Outlook.Application
Dim NSpace As Namespace
Dim AdList As AddressList
Dim AdEntries As AddressEntries

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
    Set olApp = New Outlook.Application
    Err.Clear
End If

Set NSpace = olApp.GetNamespace("MAPI")
Set AdList = NSpace.GetGlobalAddressList
Set AdEntries = AdList.AddressEntries
AdEntries.Session.GetSelectNamesDialog.Display
End Sub

A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Bonsoir à tous

david84
J'ai creuser un peu plus les tests avec ton code.
En fait, c'est le On Error qui évite le message (je l'avais pas remarqué avant )
Et je crois savoir pourquoi l'erreur se produit
En fait c'est quand la boucle rencontre une liste de distribution (qui contient donc plusieurs emails) mais qui n'a donc pas de:
AdEntry.GetExchangeUser.PrimarySmtpAddress
(ou plutôt la valeur est vide)
Pour le message d'erreur, c'est ici qu'il se produit :
VBE m'indique que T_AdEntries(i, 2) = vide et i=45
(et effectivement le 45ième item correspond à une liste de distribution)
j'ai donc ajouter ceci à ton code
(mais je ne sais pas si c'est la meilleure façon de faire)

For Each AdEntry In AdEntries
      i = i + 1
      If Not Len(AdEntry.GetExchangeDistributionList.Name) > 0 Then
      T_AdEntries(i, 1) = AdEntry.Name 'nom
      T_AdEntries(i, 2) = AdEntry.GetExchangeUser.PrimarySmtpAddress 'adresse mail
      End If
   Next AdEntry

Mais je suis obligé de laisser le On Error sinon le message d'erreur revient
Avec cet ajout, j'ai des cellules en A et B quand la boucle rencontre une liste de distribution
Je suppose que c'est à cause du Redim avec même avec l'ajout de cet If/En if, j'ai toujours au final le même nombre d'items exportés (la différence c'est que pour les listes de distribution, les cellules sont vides)

 

[david84]

Re : Importer email client a partir d'outlook 2010

Bonsoir,

effectivement tu as raison c'est On Error Resume Next qui cache l'erreur et c'est vrai également que le problème survient lorsque l'item contient (notamment ?) une liste de distribution.
Le problème c'est que ton test ne sert à rien puisque le On Error est toujours actif.
De plus l'adresse mail n'est de toutes les façons pas ramenée donc cela ne règle pas grand chose en l'état.

Ci-joint une proposition à tester : on annule le On Error Resume Next par un On Error GoTo 0 à la sortie puis on teste la propriété AddressEntryUserType. Si cette propriété = olExchangeDistributionListAddressEntry (entrée d'adresse de liste de distribution) alors

T_AdEntries(i, 2) = AdEntry.GetExchangeDistributionList.PrimarySmtpAddress

sinon

T_AdEntries(i, 2) = AdEntry.GetExchangeUser.PrimarySmtpAddress

comme c'est le cas actuellement.

Le problème c'est que la propriété AddressEntryUserType peut avoir également d'autres constantes et donc je ne suis pas sûr de régler complètement le problème mais bon avançons pas à pas et l'on verra bien où cela nous mène.

'cocher Microsoft Outlook xx Object Library
  Sub Liste_nom()
  Dim olApp As Outlook.Application
  Dim NSpace As Namespace
  Dim AdList As AddressList
  Dim AdEntries As AddressEntries
  Dim AdEntry As AddressEntry
  Dim i As Long, T_AdEntries()
  Dim t
  t = timer
  '[A:B].ClearContents 'efface les valeurs précédentes
  
  On Error Resume Next
  Set olApp = GetObject(, "Outlook.Application") 'cas où une session d'Outlook est déjà ouverte
  If Err.Number <> 0 Then
      Set olApp = New Outlook.Application 'cas où on doit créer une session d'Outlook
      Err.Clear
  End If
  
  On Error GoTo 0
  
  Set NSpace = olApp.GetNamespace("MAPI")
  'on teste si ce compte utilise un serveur Exchange
  If NSpace.ExchangeConnectionMode = olNoExchange Then
    MsgBox "Ce compte n'utilise aucun serveur Exchange"
    Exit Sub
  End If
  Set AdList = NSpace.GetGlobalAddressList 'on ramène la liste d'adresses globales
  Set AdEntries = AdList.AddressEntries 'on ramène les entrées d'adresse
  'on stocke les données dans un tableau
  ReDim T_AdEntries(1 To AdEntries.Count, 1 To 2)
  For Each AdEntry In AdEntries
      i = i + 1
      T_AdEntries(i, 1) = AdEntry.Name
      
      Select Case AdEntry.AddressEntryUserType
      Case Is = olExchangeDistributionListAddressEntry
        T_AdEntries(i, 2) = AdEntry.GetExchangeDistributionList.PrimarySmtpAddress     
      Case Else
        T_AdEntries(i, 2) = AdEntry.GetExchangeUser.PrimarySmtpAddress
      End Select
   Next AdEntry
   'on copie ces données dans la feuille de calcul
   Range("A1").Resize(UBound(T_AdEntries), 2) = T_AdEntries
   MsgBox timer - t
  End Sub

Teste de ton côté et dis-moi ce qu'il en est.
A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Bonsoir à tous

david84
Ton dernier code fonctionne sans erreur (même en ôtant le On Error)
Cependant, j'essaie désormais lorsque que le code tombe sur sur liste de distribution d'extraire les emails contenus dans cette liste
(dans l'idéal en les mettant en colonne C, dans une même cellule mais séparé par un point virgule)
J'ai juste commencer à tester ceci

Case Is = olExchangeDistributionListAddressEntry
        T_AdEntries(i, 2) = AdEntry.GetExchangeDistributionList.PrimarySmtpAddress
        j = j + 1
        For j = 1 To AdEntry.GetExchangeDistributionList.GetExchangeDistributionListMembers.Count
        MsgBox AdEntry.GetExchangeDistributionList.GetExchangeDistributionListMembers.Item(j).GetExchangeUser.PrimarySmtpAddress
        Next j
        'MsgBox  AdEntry.GetExchangeDistributionList.GetExchangeDistributionListMembers.GetFirst.GetExchangeUser.PrimarySmtpAddress
        'MsgBox  AdEntry.GetExchangeDistributionList.GetExchangeDistributionListMembers.GetLast.GetExchangeUser.PrimarySmtpAddress
      Case Else

Cela fonctionne mais faute de temps, je n'ai pas pu aller plus loin

Si tu as le temps de tester la chose (car j n'ai pas d'Exchange à disposition à domicile ), merci d'avance à toi

 

[david84]

Re : Importer email client a partir d'outlook 2010

Bonjour,
@JM : j'ai regardé vite donc pas trop testé. Vois de ton côté si cela te convient :

'cocher Microsoft Outlook xx Object Library
  Sub Liste_nom()
  Dim olApp As Outlook.Application
  Dim NSpace As Namespace
  Dim AdList As AddressList
  Dim AdEntries As AddressEntries
  Dim AdEntry As AddressEntry
  Dim i As Long, j As Long, T_AdEntries()
  Dim EDLMembers As String
  Dim t
  
  t = timer
  [A:B].ClearContents 'efface les valeurs précédentes
  
  On Error Resume Next
  Set olApp = GetObject(, "Outlook.Application") 'cas où une session d'Outlook est déjà ouverte
  If Err.Number <> 0 Then
      Set olApp = New Outlook.Application 'cas où on doit créer une session d'Outlook
      Err.Clear
  End If
  
  On Error GoTo 0
  
  Set NSpace = olApp.GetNamespace("MAPI")
  'on teste si ce compte utilise un serveur Exchange
  If NSpace.ExchangeConnectionMode = olNoExchange Then
    MsgBox "Ce compte n'utilise aucun serveur Exchange"
    Exit Sub
  End If
  
  Set AdList = NSpace.GetGlobalAddressList 'on ramène la liste d'adresses globales
  Set AdEntries = AdList.AddressEntries 'on ramène les entrées d'adresse
  'on stocke les données dans un tableau
  ReDim T_AdEntries(1 To AdEntries.Count, 1 To 3)
  For Each AdEntry In AdEntries
      i = i + 1
      T_AdEntries(i, 1) = AdEntry.Name
      
      Select Case AdEntry.AddressEntryUserType
      Case Is = olExchangeDistributionListAddressEntry
        T_AdEntries(i, 2) = AdEntry.GetExchangeDistributionList.PrimarySmtpAddress
        If AdEntry.GetExchangeDistributionList.GetExchangeDistributionListMembers.Count > 0 Then
          For j = 1 To AdEntry.GetExchangeDistributionList.GetExchangeDistributionListMembers.Count
            EDLMembers = EDLMembers & ";" & _
            AdEntry.GetExchangeDistributionList.GetExchangeDistributionListMembers.Item(j).GetExchangeUser.PrimarySmtpAddress
          Next j
          T_AdEntries(i, 3) = Right(EDLMembers, Len(EDLMembers) - 1): EDLMembers = vbNullString
        End If
      Case Else
        T_AdEntries(i, 2) = AdEntry.GetExchangeUser.PrimarySmtpAddress
      End Select
   Next AdEntry
   'on copie ces données dans la feuille de calcul
   Range("A1").Resize(UBound(T_AdEntries), 3) = T_AdEntries
   MsgBox timer - t
  End Sub

A+

 

[david84]

Re : Importer email client a partir d'outlook 2010

Bonjour

Staple1600 : suite à ta demande je te joins une procédure je pense plus aboutie mais qui peut être améliorée.
J'ai pu la tester sur 4 type d'utilisateurs :
- olExchangeUserAddressEntry (0)
- olExchangeDistributionListAddressEntry (1)
- olExchangeAgentAddressEntry (3)
- olExchangeRemoteUserAddressEntry (5)

Il manque bien sûr des types Ce lien n'existe plus mais ceux inscrits dans ma listes ne proviennent que des types cités ci-dessus.

'cocher Microsoft Outlook xx Object Library
Sub GlobalAddressList()
Dim olApp As Outlook.Application
Dim NSpace As Namespace
Dim AdList As AddressList
Dim AdEntries As AddressEntries
Dim AdEntry As AddressEntry
Dim i As Long, j As Long
Dim oMembers As AddressEntries
Dim oMember As AddressEntry
Dim T_oMembers()

[A:C].ClearContents 'efface les valeurs précédentes

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application") 'cas où une session d'Outlook est déjà ouverte
If Err.Number <> 0 Then
    Set olApp = New Outlook.Application 'cas où on doit créer une session d'Outlook
    Err.Clear
End If

On Error GoTo 0

Set NSpace = olApp.GetNamespace("MAPI")
'on teste si ce compte utilise un serveur Exchange
If NSpace.ExchangeConnectionMode = olNoExchange Then
  MsgBox "Ce compte n'utilise aucun serveur Exchange"
  Exit Sub
End If

Set AdList = NSpace.GetGlobalAddressList 'on ramène la liste d'adresses globales
Set AdEntries = AdList.AddressEntries 'on ramène les entrées d'adresse

For Each AdEntry In AdEntries
  i = i + 1
  Cells(i, 1) = AdEntry.Name
  
  Select Case AdEntry.AddressEntryUserType
  Case Is = olExchangeDistributionListAddressEntry
    Cells(i, 2) = AdEntry.GetExchangeDistributionList.PrimarySmtpAddress
    
    Set oMembers = AdEntry.GetExchangeDistributionList.GetExchangeDistributionListMembers
    If oMembers.Count > 0 Then
      ReDim T_oMembers(1 To oMembers.Count)
      For Each oMember In oMembers
        If oMember.AddressEntryUserType = olExchangeUserAddressEntry Then
          j = j + 1
          T_oMembers(j) = oMember.GetExchangeUser.PrimarySmtpAddress
        Else
          Cells(i, 3) = oMember.AddressEntryUserType
        End If
      Next oMember

      If j > 0 Then Cells(i, 3) = Join(T_oMembers, ";"): j = 0
    End If
    
  Case Is = olExchangeUserAddressEntry, olExchangeRemoteUserAddressEntry
    Cells(i, 2) = AdEntry.GetExchangeUser.PrimarySmtpAddress
    
  Case Else 'olExchangeOrganizationAddressEntry, olExchangeAgentAddressEntry
    Cells(i, 2) = AdEntry.AddressEntryUserType 'on note le type d'utilisateur
  End Select
  DoEvents
Next AdEntry

[A:C].EntireColumn.AutoFit
MsgBox "Traitement terminé !"
End Sub

Dans la procédure si dessus j'ai préféré incrémenter directement les données dans la feuille plutôt que de passer par un tableau car cela me semble plus sûr et d'autre part on peut suivre le déroulement dans la feuille de calcul sans "figer" le déroulement.

A noter le cas des olExchangeDistributionListAddressEntry qui peuvent soit contenir des adresses mails (dans ce cas elles sont notées dans la colonne C) soit contenir d'autres listes de distribution : dans ce cas la colonne C ne comporte que l'information liée à la constante olExchangeDistributionListAddressEntry soit 1. J'ai bien tenté de ramener les adresses placées dans cette "sous-liste" mais j'obtiens alors une erreur d'exécution "impossible de terminer l'opération car le fournisseur de service ne la prend pas en charge".

Lorsque le type d'utilisateur n'a pu être spécifiquement testé

Case Else 'olExchangeOrganizationAddressEntry, olExchangeAgentAddressEntry

le type d'utilisateur est noté dans la feuille.

A tous ceux qui ont un compte Exchange vous pouvez tester le code ci-dessous :

'cocher Microsoft Outlook xx Object Library
  Sub Type_utilisateur()
  Dim olApp As Outlook.Application
  Dim NSpace As Namespace
  Dim AdList As AddressList
  Dim AdEntries As AddressEntries
  Dim AdEntry As AddressEntry
  Dim i As Long
  
  '[A:B].ClearContents 'efface les valeurs précédentes
  
  On Error Resume Next
  Set olApp = GetObject(, "Outlook.Application") 'cas où une session d'Outlook est déjà ouverte
  If Err.Number <> 0 Then
      Set olApp = New Outlook.Application 'cas où on doit créer une session d'Outlook
      Err.Clear
  End If
  
  On Error GoTo 0
  
  Set NSpace = olApp.GetNamespace("MAPI")
  
  'on teste si ce compte utilise un serveur Exchange
  If NSpace.ExchangeConnectionMode = olNoExchange Then
    MsgBox "Ce compte n'utilise aucun serveur Exchange"
    Exit Sub
  End If
  
  Set AdList = NSpace.GetGlobalAddressList 'on ramène la liste d'adresses globales
  Set AdEntries = AdList.AddressEntries 'on ramène les entrées d'adresse
  For Each AdEntry In AdEntries 
    'If AdEntry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
      i = i + 1
      Cells(i, 1) = AdEntry.Name
      Cells(i, 2) = AdEntry.AddressEntryUserType
    'End If
   Next AdEntry

   MsgBox "Traitement terminé"
  End Sub

Si la procédure ramène d'autres types d'utilisateurs que ceux indiqués au début de ce message dites-le. On pourra alors tester plus avant si le type en question possède une adresse smtp.
A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Bonsoir à tous

david84
Merci de continuer à creuser la question.
Demain, j'aurai du temps pour tester tes derniers codes.

Je pensais à suivre cette piste :
1) exporter les adresses emails seules sur une feuilles
(en mettant dans une colonne l'alias si il existe et dans la colonne adjacente l'adresse email.

2) et exporter les listes de distributions sur une autre feuille ( une liste par colonne )
et en ligne 1 le nom des listes de distribution
et les adresse emails contenus la liste, en dessous dans la colonne correspondant à la liste.

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Bonsoir à tous

david84
Tests OK sur tes derniers codes.

Si jamais tu as le temps de voir ce que t'inspires la suggestion de mon précédent message, je suis preneur
(car difficile pour moi de faire des tests au boulot en cette période de clôture budgétaire et encore plus difficile de tester at home puisque pas d'Exchange à dispostion )

 

[david84]

Re : Importer email client a partir d'outlook 2010

Bonjour,

Bonsoir à tous

david84
Tests OK sur tes derniers codes.

Si jamais tu as le temps de voir ce que t'inspires la suggestion de mon précédent message, je suis preneur
(car difficile pour moi de faire des tests au boulot en cette période de clôture budgétaire et encore plus difficile de tester at home puisque pas d'Exchange à dispostion )

J'ai un compte Exchange sur un portable pro mais de chez moi je n'ai pas de connexion à Exchange donc il y a des choses que je ne peux pas tester en dehors du travail.

Concernant ta demande il me faudrait plus de détails.

1) exporter les adresses emails seules sur une feuilles
(en mettant dans une colonne l'alias si il existe et dans la colonne adjacente l'adresse email.

De quel type d'utilisateur parles-tu ? Uniquement de ceux correspondant à

Case Is = olExchangeUserAddressEntry, olExchangeRemoteUserAddressEntry
    Cells(i, 2) = AdEntry.GetExchangeUser.PrimarySmtpAddress

et donc dans ce cas l'alias en colonne 1 et l'adresse mail en colonne 2 ?

2) et exporter les listes de distributions sur une autre feuille ( une liste par colonne )
et en ligne 1 le nom des listes de distribution
et les adresse emails contenus la liste, en dessous dans la colonne correspondant à la liste.

et dans une autre feuille les données correspondant à ce cas

Case Is = olExchangeDistributionListAddressEntry

le nom de la liste de distribution en en-tête de colonne et les adresses mails en dessous ?

D'autre part as-tu testé la procédure Sub Type_utilisateur ?
Si oui te ramène-t-elle d'autres types d'utilisateurs que les 4 répertoriés au début de mon précédent message ?
Si oui lesquels ?
A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Bonjour à tous

david84
Voila à quoi je pensais
NB: Je testerai lundi la procédure Type_Utilisateur (que je n'ai pas testé encore)
Sur la feuille 1

Mr TOTO1	toto1@domain.fr
Mme Tata	tata@domain.fr
Secrétariat UNTEL	martine.martin@domain.net

Sur la feuille 2

LIST.DIST1	LIST.DIST2	LIST.DIST3
email1LD1@domain.fr	email1LD2@domain.fr	email1LD3@domain.fr
email2LD1@domain.fr	email2LD2@domain.fr	email2LD3@domain.fr

 

[david84]

Re : Importer email client a partir d'outlook 2010

1) exporter les adresses emails seules sur une feuilles
(en mettant dans une colonne l'alias si il existe...

Mr TOTO1

Sur la feuille 1 colonne 1 tu veux l'alias ou le nom (c'est 2 propriété différentes).
A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Bonjour david84

Pour moi l'alias, c'est la partie en gras dans cet exemple
(quand on envoie un mail c'est ainsi que l'adresse email apparait dans le champ A: , le gras en moins )
Staple1600<excel@tableur.com>

Puisque qu'on est parti à tililler Outlook dans les grandes largeurs, soyons gourmands
Alors disons

NOM |ALIAS| EMAIL sur la feuille 1

 

[david84]

Re : Importer email client a partir d'outlook 2010

Donc c'est plutôt le nom que tu veux et non pas l'alias.
Je regarde pour ta 1ère demande.
A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Re

david84
Pour moi, c'est l'alias
Sinon c'est quoi ce que toi tu appelles l'alias ?