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

 

[david84]

Re : Importer email client a partir d'outlook 2010

A tester :

'cocher Microsoft Outlook xx Object Library
Sub Username_et_mail()
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
  
With Sheets("Feuil1")
  .[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 = olExchangeUserAddressEntry Or _
    AdEntry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
      i = i + 1
      .Cells(i, 1) = AdEntry.Name 'le nom
      '.Cells(i, 1) = AdEntry.GetExchangeUser.Alias 'l'alias
      .Cells(i, 2) = AdEntry.GetExchangeUser.PrimarySmtpAddress
    End If
    DoEvents
  Next AdEntry
  .[A:B].EntireColumn.AutoFit
End With
MsgBox "Traitement terminé !"
End Sub

Je t'ai placé l'alias en commentaire. A toi de voir ce que tu veux ramener en colonne 1.

Pour ta 2ème demande il me faut une connexion Exchange ce que je n'ai pas chez moi.
J'ai fait une macro mais je la testerai au travail pour voir si elle fonctionne correctement.
A+

 

[david84]

Re : Importer email client a partir d'outlook 2010

Ah je viens de voir que tu as actualisé ta demande...donc :

'cocher Microsoft Outlook xx Object Library
Sub User_name_et_alias_et_mail()
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
  
With Sheets("Feuil1")
  .[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
    If AdEntry.AddressEntryUserType = olExchangeUserAddressEntry Or _
    AdEntry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
      i = i + 1
      .Cells(i, 1) = AdEntry.Name 'le nom
      .Cells(i, 2) = AdEntry.GetExchangeUser.Alias 'l'alias
      .Cells(i, 3) = AdEntry.GetExchangeUser.PrimarySmtpAddress
    End If
    DoEvents
  Next AdEntry
  .[A:C].EntireColumn.AutoFit
End With
MsgBox "Traitement terminé !"
End Sub

A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Re


david84
je testerai lundi également.
Merci pour tout ces jolis codes VBA en tout cas

Remarques
J'ai beau chercher mais sauf erreur de ma part la méthode ci-dessous
4 manières de exporter des contacts depuis Outlook
n'exporte que les contacts du carnet d'adresses pas le contenu de la Global Address List

Il n'existe donc aucune option (avancée ou pas) qui permet de faire directement un export csv de la Global Address List ?

Tu confirmes ce point ?

La seule solution est donc ton code VBA

(Par contre cela semble possible avec les outils présents sur le serveur Exchange, mais cela ne concerne donc pas l'utilisateur lambda d'Outlook)

 

[david84]

Re : Importer email client a partir d'outlook 2010

Bonjour,
ci-joint un essai pour traiter le point 2 de ton message #40 :

'cocher Microsoft Outlook xx Object Library
Sub ExchangeDistributionList()
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

With Sheets("Feuil2")
  .Cells.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 = olExchangeDistributionListAddressEntry Then
      i = i + 1
      .Cells(1, i) = AdEntry.Name
      j = 1
      On Error Resume Next
      Set oMembers = AdEntry.GetExchangeDistributionList.GetExchangeDistributionListMembers
      Select Case Err.Number
      Case Is = 0
      If oMembers.Count > 0 Then
        For Each oMember In oMembers
          j = j + 1
          If oMember.AddressEntryUserType = olExchangeUserAddressEntry Then
            .Cells(j, i) = oMember.GetExchangeUser.PrimarySmtpAddress
          Else
            .Cells(j, i) = oMembers.Parent.PrimarySmtpAddress
          End If
        Next oMember
      End If
      Case Else 'erreur d'exécution -2147221227
        .Cells(2, i) = Err.Description: Err.Clear
      End Select
    End If
    DoEvents
  Next AdEntry
  .UsedRange.EntireColumn.AutoFit
End With
MsgBox "Traitement terminé !"
End Sub

Comme expliqué dans l'un de mes précédents messages il se peut qu'en fonction de la liste de distribution le traitement provoque une erreur "Impossible de terminer l'opération car le fournisseur de service ne la prend pas en charge" (je ne sais pas ce qui provoque cela).
Donc si l'erreur est levée la description de l'erreur est inscrite en ligne 2.
Dans le cas contraire 2 cas de figure :
- si le type d'utilisateur de la liste de distribution est = olExchangeUserAddressEntry alors on récolte les adresses mails contenues dans la liste ;
- si ce n'est pas le cas c'est que la liste de distribution ne contient pas directement d'adresse mail (à vérifier mais c'est ce que j'en ai déduis). On ramène alors l'adresse mail de l'objet oMembers.
C'est une 1ère approche, donc à tester plus avant de ton côté.

D'autre part dis-moi ce que donne la macro du message #46, sans oublier également ma demande précédente

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 ?

Il n'existe donc aucune option (avancée ou pas) qui permet de faire directement un export csv de la Global Address List ?

Tu confirmes ce point ?

Je n'ai pas creusé la question mais a priori cela me paraît bizarre que ce ne soit pas possible...à voir.
A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Bonsoir à tous

david84
La macro Type_Utilisateur ne renvoit à mon boulot que trois valeurs : 0,1,5
- olExchangeUserAddressEntry (0)
- olExchangeDistributionListAddressEntry (1)
- olExchangeRemoteUserAddressEntry (5)
Ton dernier code : Sub ExchangeDistributionList() -> TEST OK (pas d'erreur)

 

[david84]

Re : Importer email client a partir d'outlook 2010

Bonjour,
quand tu mets un point d'arrêt sur la ligne

.Cells(2, i) = Err.Description: Err.Clear

la procédure est-elle stoppée à un moment donné ? Si oui quelle est l'erreur ramenée dans la cellule ?
A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Bonsoir à tous

david84
J'ai donc mis un point d'arrêt puis exécuter la macro
Et je n'ai rien vu.
Donc j' ai modifié comme suit :
.Cells(2, i) = "ERREUR: " & Err.Description: Err.Clear
J'ai relancé de nouveau la macro
Puis Edition/Rechercher/ ERREUR et toujours nada
Est-ce normal, docteur ?
Ou cela signifie t-il qu'il n'y a aucune erreur générée ?

 

[david84]

Re : Importer email client a partir d'outlook 2010

...Ou cela signifie t-il qu'il n'y a aucune erreur générée ?

C'est bien cela, aucune erreur n'est générée.
Je voulais vérifier si tu avais également le message

"Impossible de terminer l'opération car le fournisseur de service ne la prend pas en charge"

ou un autre. Visiblement ce n'est pas le cas.
Donc à moins d'autres tests effectués par d'autres membres qui ramèneraient notamment d'autres types d'utilisateurs, je ne vois pas ce que je peux rajouter de plus pour l'instant.
A+

 

[Staple1600]

Re : Importer email client a partir d'outlook 2010

Re

david84
Par contre j'avais des cellules vides dans les colonnes d'emails
(Ce qui voudrait dire qu'il y a des membres des liste de distributions sans émail renseignés)

Une idée au passage:
Peut-il y avoir des doublons dans une liste de distribution?
Peut-il y avoir des emails invalides ?
Si oui les détecter ?

Sinon

Je n'ai pas creusé la question mais a priori cela me paraît bizarre que ce ne soit pas possible...à voir.

Pas de nouveaux éléments à ce sujet de ton côté ?

 

[david84]

Re : Importer email client a partir d'outlook 2010

Bonsoir,

Une idée au passage:
Peut-il y avoir des doublons dans une liste de distribution?
Peut-il y avoir des emails invalides ?
Si oui les détecter ?

Il peut y avoir des doublons bien sûr. Concernant les mails invalides ils ne sont pas à exclure.
Pour les vérifier je pense qu'il faut le faire une fois que l'ensemble des adresses mails est reportée sur la feuilles.
La méthode la plus adaptée est une fonction utilisant une expression rationnelle.

Pas de nouveaux éléments à ce sujet de ton côté ?

Je n'ai pas regardé pour l'instant.
A+

 

[Jeannot87]

Bonjour à tous,

Je débute en macro excel,

Je dépoussière ce sujet qui n'a pas été réouvert depuis un moment.

La macro de David84 est fonctionne très bien chez moi.

'cocher Microsoft Outlook xx Object Library Sub User_name_et_alias_et_mail() 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 With Sheets("Feuil1") .[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 If AdEntry.AddressEntryUserType = olExchangeUserAddressEntry Or _ AdEntry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then i = i + 1 .Cells(i, 1) = AdEntry.Name 'le nom .Cells(i, 2) = AdEntry.GetExchangeUser.Alias 'l'alias .Cells(i, 3) = AdEntry.GetExchangeUser.PrimarySmtpAddress End If DoEvents Next AdEntry .[A:C].EntireColumn.AutoFit End With MsgBox "Traitement terminé !" End Sub

J'aurais besoin d'aller plus loin et de mettre toutes les infos Adresses, Ville, codes postales, Pays, Titre, Société, Service, Bureau, téléphones (fixe + mobile).

Savez vous comment je peux la modifier ?

Cordialement,

Jeannot87