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