Macro pour exporter le calendrier complet outlook en format vcalendar (vcs)

Commenter

Contenu du snippet

J'aurai aimé pouvoir trouver cette option directement dans Outlook, mais apparemment ce n'était pas prévu.
Il est possible d'enregistrer chaque événement un par un en format vcs (vCalendar) mais pas d'exporter tout le calendrier.
Voici donc une petite macro permettant d'exporter tous les événements dans un fichier qui peut ensuite être importé dans un agenda collectif en ligne (WebCalendar par exemple).
Il doit être assez simple d'en faire une version pour iCalendar.

Source / Exemple : 


Sub export()

Dim dirLocation As String
   
    dirLocation = InputBox("Donnez un emplacement sur votre disque et un nom de fichier avec l'extsension .vcs (e.g., c:\cal.vcs). Vous pourrez importer ce fichier à partir de WEbcalendar")
    If dirLocation = Null Or Len(dirLocation) = 0 Then
        Exit Sub
    End If
    
    Dim objApplication As Outlook.Application
    Dim objNameSpace As Outlook.NameSpace
    Dim objAppointments As Outlook.MAPIFolder
    Dim objAppointment As Outlook.AppointmentItem
    Dim appointmentIndex As Integer

    Set objApplication = CreateObject("Outlook.Application")
    Set objNameSpace = objApplication.GetNamespace("MAPI")
    Set objAppointments = objNameSpace.GetDefaultFolder(olFolderCalendar)

    Open dirLocation For Output As #6
    Print #6, "BEGIN:VCALENDAR"
    Print #6, "PRODID:-//Microsoft Corporation//Outlook 9.0 MIMEDIR//EN"
    Print #6, "VERSION:1.0"
    For appointmentIndex = 1 To objAppointments.Items.Count
        Set objAppointment = objAppointments.Items.item(appointmentIndex)
        Print #6, "BEGIN:VEVENT"
        If objAppointment.AllDayEvent = True Then
          Print #6, "TRANSP:1"
        End If
        Print #6, "DTSTART:" & Format(objAppointment.Start, "yyyymmdd") & "T" & Format(objAppointment.Start, "hhmmss") & "Z"
        Print #6, "DTEND:" & Format(objAppointment.Start, "yyyymmdd") & "T" & Format(objAppointment.Start, "hhmmss") & "Z"
        Print #6, "SUMMARY;ENCODING=QUOTED-PRINTABLE:" & objAppointment.Subject
        Print #6, "DESCRIPTION;ENCODING=QUOTED-PRINTABLE:" & objAppointment.Body
        Print #6, "PRIORITY:" & objAppointment.Importance
        Print #6, "END:VEVENT"
     
    Next
    Print #6, "END:VCALENDAR"
    Close #6
    MsgBox "Le calendrier a été exporté dans : " & dirLocation
    End Sub

Conclusion :


Bon, j'espère que ce sera utile à certains

A voir également