En poursuivant votre navigation sur ce site, vous acceptez l'utilisation de cookies pour vous proposer des contenus et services adaptés. Mentions légales.

Recherche

Recherche

Les mémos

Je débute...

Visites

 1237988 visiteurs

 11 visiteurs en ligne

Nous contacter

Contact

Exporter les contacts

Exporter les contacts d'Outlook

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

Catégorie : Les mémos - Outlook
Page lue 7491 fois
Vous êtes ici :   Accueil » Exporter les contacts