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
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 :
Code:
'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 :
Code:
'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
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)
Code:
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)
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
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.
Code:
'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
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
VB:
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
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 :
Code:
'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
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.
Code:
'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
A tous ceux qui ont un compte Exchange vous pouvez tester le code ci-dessous :
Code:
'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+
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.
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 )
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 à
Code:
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
Code:
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+
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