Rdv vers outlook sur calendrier partagé

Bonjour à tous,

J'utilise un fichier pour de la prospection qui permet d'envoyer des dates vers Outlook.

Ce fichier est bien fonctionnel, sauf maintenant, j'aimerai pouvoir envoyer ces dates vers un calendrier qui est partagé.

Je m'explique :

Aujourd'hui, ces dates sont envoyées dans un calendrier "PROSPECTION" créé dans le groupe Mes Calendrier.

Je souhaiterai changer en envoyant ces dates dans un calendrier toujours appelé "PROSPECTION" mais qui est dans le groupe CALENDRIERS PARTAGES....

Pour cela, j'ai supprimé mon calendrier actuel "PROSPECTION", et j'ai ouvert le nouveau calendrier Prospection qu'une personne a partagé avec moi... Bien évidemment, j'ai un erreur quand j'exécute la macro.

Je n'arrive pas à trouver quel remplacement faire dans mon code, malgré des recherches faites sur internet etc...

Si quelqu'un aurait une idée.......

Merci

Voici le code

Sub ajout()

    Dim DateDebut As String
    Dim Nom As String
    Dim journee As String
    Dim sSearch As String
    Dim OutlApp As New Outlook.Application
    Dim OutlItems As Outlook.Items
    Dim OutlAppointment As Outlook.AppointmentItem
    Dim MyCalendar As Outlook.Items
    Dim OutlMapi As Outlook.Namespace
    Dim OutlFolder As Outlook.MAPIFolder
    Dim MyItem As Outlook.AppointmentItem
    Dim Cell As Range
    Dim cal As String

    'plage de donnée
   For Each Cell In Range("A4:A" & Range("A6000").End(xlUp).Row)
        'fin de plage de donnée

        'Pour la vérification des doublons on utilise les données suivantes :
       If Cell <> "" Then    'recherche dans la plage si il existe des données à inscrire

            If Cell.Offset(0, 14) <> "" Then
                DateDebut = Cell.Offset(0, 14) & " " & Cell.Offset(0, 15)    'date
               Nom = "Relance" & " " & Cell.Offset(0, 0) & " - " & Cell.Offset(0, 1)    'nom
               journee = Cell.Offset(0, 6)    ' Toute la journée oui/non
               'Fin des données pour la valitation de doublon

                'Crée la sélection du calendrier dans Outlook
               Set OutlApp = CreateObject("Outlook.Application")
                Set OutlMapi = OutlApp.GetNamespace("MAPI")
                Set OutlFolder = OutlMapi.GetDefaultFolder(olFolderCalendar)
                Set OutlItems = OutlFolder.Folders("prospection").Items    ' Nom du calendrier - Attention calendrier ajouté en dessous du calendrier par default et nom dans un nouveau groupe.
               'Set OutlItems = OutlFolder.Items ' Calendrier par default

                'Vérification de doublon pour les rdv
               On Error Resume Next
                sSearch = "[AllDayEvent] = '" & journee & "' and [Start] = '" & DateDebut & "' and  [Subject] = '" & Nom & "'"
                Set OutlAppointment = OutlItems.Find(sSearch)
                On Error GoTo 0
                'fin vérification doublon

                If OutlAppointment Is Nothing Then    's'il n'y a pas de doublons lancement du code
                   'On choisi le calendrier
                   Set MyCalendar = OutlItems    'choix calendrier
                   'Fin choix calendrier

                    Set MyItem = MyCalendar.Add(olAppointmentItem)

                    With MyItem    'inscription des données dans excel
                       .MeetingStatus = olNonMeeting    'meeting
                       .Subject = "Relance" & " " & Cell.Offset(0, 0) & " - " & Cell.Offset(0, 1)    'Sujet
                       .Start = Cell.Offset(0, 14) & " " & Cell.Offset(0, 15)    ' Date plus heure. Heure toujours mettre cellude vide
                       .Duration = 30    'durée du RDV en minute"
                       .Location = Cell.Offset(0, 4) & " - " & Cell.Offset(0, 5)    'emplacement
                       .AllDayEvent = True    ' Ou remplacer par cell.offset si a déterminer dans cellule
                       .ReminderSet = True    ' Ou remplacer par cell.offset si à déterminer dans cellule
                       .ReminderMinutesBeforeStart = 1    ' Durée du rappel en minute
                       .body = Cell.Offset(0, 13)    'Pour les commentaires ou sujets
                       .Categories = "PROSPECTION" 'S'assurer que la catégorie "" est bien créé dans le calendrier avec couleur au choix
                        .Save

                    End With
                    Set MyItem = Nothing
                End If
            End If
        End If
    Next Cell    'tant que les cellules de la plage est complete on relance le macro

End Sub