Tables
Formulaires
Automation
Administration
Envoyer un mail
Outlook
Dates - Heures
Fichiers
Références
La normalisation
VBA
992295 visiteurs
1 visiteur en ligne
Cette méthode tient compte des éventuels champs personnalisés
Sub ExportOutlookContacts(strFile As String, _ Optional Delim = """", Optional Separ = ",") On Error Resume Next Dim txtLine As String Dim Fichier As Integer Dim Ol_App As New Outlook.Application Dim Ol_Mapi As Outlook.NameSpace Dim Ol_Folder As Outlook.MAPIFolder Dim Ol_Items As Outlook.Items Dim Ol_Contact As Outlook.ContactItem Dim Ol_Prp As Outlook.ItemProperty Set Ol_Mapi = Ol_App.GetNamespace("MAPI") Set Ol_Folder = Ol_Mapi.GetDefaultFolder(olFolderContacts) Set Ol_Items = Ol_Folder.Items Set Ol_Contact = Ol_Items.Item(1) Fichier = FreeFile() Open strFile For Output As #Fichier For Each Ol_Prp In Ol_Contact.ItemProperties If Ol_Prp.Type = olDateTime Or Ol_Prp.Type = olText Then txtLine = txtLine & Delim & Ol_Prp.Name & Delim & Separ End If Next Ol_Prp txtLine = Left(txtLine, Len(txtLine) - Len(Separ)) Print #Fichier, txtLine txtLine = "" For Each Ol_Contact In Ol_Items For Each Ol_Prp In Ol_Contact.ItemProperties If Ol_Prp.Type = olDateTime Or Ol_Prp.Type = olText Then txtLine = txtLine & Delim & Ol_Prp.Value & Delim & Separ End If Next Ol_Prp txtLine = Left(txtLine, Len(txtLine) - Len(Separ)) Print #Fichier, txtLine txtLine = "" Next Ol_Contact Close #Fichier Set Ol_Prp = Nothing Set Ol_Contact = Nothing Set Ol_Items = Nothing Set Ol_Folder = Nothing Set Ol_Mapi = Nothing Set Ol_App = Nothing MsgBox "Fichier " & strFile & " créé.", vbOKOnly, "" End Sub
Syntaxe:
Sub ExportContactsTXT() 'Format TXT tabulé Call ExportOutlookContacts("F:Mes DocumentsContacts.txt", Null, vbTab) End Sub
Sub ExportContactsCSV() 'Format CSV Call ExportOutlookContacts("F:Mes DocumentsContacts.csv") End Sub