XL 2013 Importation calendrier Outlook

[degards]

Bonjour à tous,
Dans une de mes projets j'aimerais importer des rendez-vous qui se trouve dans un calendrier qui se retrouve dans le dossier public de mon organisation. Je suis capable de récupérer mes rendez-vous à moi mais je ne sais pas comment accéder à ceux du dossier public. Je suis capable de voir les propriétés du calendrier mais comment l'indiquer dans ma macro. J'ai trouvé ce code qui rempli bien ce que je demande mais j'ignore où faire ma modification pour le calendrier public qui se nomme "Planification-Patrouille". De plus quand je regarde c'est propriété, je réussi a voir son emplacement qui est : \\Dossiers publics - ******** j'ai dû cacher une parti du chemin ******** Missisquoi

J'ai même réussi à trouvé son ID : 000000001A447390AA6611CD9BC800AA002FC45A0380C7933BA462E7E843A8141C81876EF43900009EDB71580000


Est-ce que quelqu'un peut m'éclairer un peu ?

Merci

Degards

Sub GetFutureOutlookEvents()
    Dim oOutlook              As Object
    Dim oNS                   As Object
    Dim oAppointments         As Object
    Dim oFilterAppointments   As Object
    Dim oAppointmentItem      As Object
    Dim bOutlookOpened        As Boolean
    Dim i                     As Long
    Const olFolderCalendar = 9
 
    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")    'Bind to existing instance of Outlook
    If Err.Number <> 0 Then    'Could not get instance of Outlook, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
        bOutlookOpened = False    'Outlook was not already running, we had to start it
    Else
        bOutlookOpened = True    'Outlook was already running
    End If
    On Error GoTo Error_Handler
    DoEvents
 
    Set oNS = oOutlook.GetNamespace("MAPI")
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
    'Apply a filter so we don't waste our time going through old stuff if we don't need to.
    sFilter = "[Start] > '" & Date & "'"
    Set oFilterAppointments = oAppointments.Items.Restrict(sFilter)
    Debug.Print oFilterAppointments.Count & " appointments found."
    'Iterate through each appt in our calendar
    For Each oAppointmentItem In oFilterAppointments
        Debug.Print oAppointmentItem.Subject, oAppointmentItem.Start, oAppointmentItem.End
    Next
 
    If bOutlookOpened = False Then    'Since we started Outlook, we should close it now that we're done
        oOutlook.Quit 'There seems to be a delay in this action taking place, but does eventually take place
    End If
 
Error_Handler_Exit:
    On Error Resume Next
    Set oAppointmentItem = Nothing
    Set oFilterAppointments = Nothing
    Set oAppointments = Nothing
    Set oNS = Nothing
    Set oOutlook = Nothing
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetFutureOutlookEvents" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub