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

 1224948 visiteurs

 10 visiteurs en ligne

Nous contacter

Contact

Exporter les rendez-vous

Exporter les rendez-vous du calendrier Outlook

Cette méthode permet d'exporter les éventuels champs personnalisés
 

Sub ExportRDV(strFile As String, Optional Delim = """", Optional Separ = ",")
    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_Appointment As Outlook.AppointmentItem
    Dim Ol_Prp As Outlook.ItemProperty
    Dim txtLine As String
    Dim Fichier As Integer

    Set Ol_Mapi = Ol_App.GetNamespace("MAPI")
    Set Ol_Folder = Ol_Mapi.GetDefaultFolder(olFolderCalendar)
    Set Ol_Items = Ol_Folder.Items
    Set Ol_Appointment = Ol_Items.Item(1)

    Fichier = FreeFile()
    Open strFile For Output As #Fichier
    For Each Ol_Prp In Ol_Appointment.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_Appointment In Ol_Items
        For Each Ol_Prp In Ol_Appointment.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_Appointment

    Close #Fichier
    MsgBox "Fichier " & strFile & " créé.", vbOKOnly, ""

    Set Ol_Prp = Nothing:      Set Ol_Appointment = Nothing
    Set Ol_Items = Nothing:     Set Ol_Folder = Nothing
    Set Ol_Mapi = Nothing:     Set Ol_App = Nothing
End Sub

Syntaxe:

Sub ExportRdvTXT()
    'Format TXT tabulé
    Call ExportRDV("C:Mes DocumentsContacts.txt", Null, vbTab)
End Sub

   

Sub ExportRdvCSV()
    'Format CSV
    Call ExportRDV("C:Mes DocumentsContacts.csv")
End Sub

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