Supprimer des rendez-vous outlook 2016 via excel

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("K2:K3")) Is Nothing Then
On Error Resume Next
If Target.Value = "OUI" Then
Dim oOutlook As Outlook.Application
    Dim oAppointment As Outlook.AppointmentItem
    Dim namespaceOutlook As Outlook.Namespace
    Dim DossierCalendrier As Outlook.MAPIFolder
 'gestion d'erreurs
    On Error GoTo Err_Execution
    'on crée ensuite les objets
    Set oOutlook = CreateObject("Outlook.Application")
    Set namespaceOutlook = oOutlook.GetNamespace("MAPI")

    'définit le dossier calendrier
    'GetDefaultFolder renvoit le calendrier du compte actif
    Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
    
    'on crée un nouveau rendez-vous
    Set oAppointment = DossierCalendrier.Items.Add
    
    'on renseigne ensuite les principaux paramètres
    With oAppointment
        .Start = "21/03/2018  15:30:00"
        .Subject = Range("g" & Target.Row).Value
        .Location = Range("h" & Target.Row).Value
        .Body = Range("k" & Target.Row).Value
        .Duration = 60
        .ReminderSet = True
        .Save
        .Close (olSave)
    End With
    
    'Libération des variables.
    Set oAppointment = Nothing
    Set oOutlook = Nothing
    MsgBox "RDV réussi"
'Fin_Execution:
    Exit Sub
'Err_Execution:
    MsgBox Err.Description, vbExclamation
    Resume Fin_Execution
ElseIf Target.Value = "TERMINER" Then
'déclaration des variables
  'on déclare un objet collection qui va contenir tous les rdv correspondat aux critères de filtre
    Dim collectionAppointments As Outlook.Items
    Dim sFilter As String
    'gestion d'erreurs
   ' On Error GoTo Err_Execution
    
    'on crée ensuite les objets
    Set oOutlook = CreateObject("Outlook.Application")
    Set namespaceOutlook = oOutlook.GetNamespace("MAPI")

    'définit le dossier calendrier
    Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)

    'on définit les critères de filtre
    'la date doit être formaté au format Outlook
    sFilter = "[Start] > '" & Format("21/03/2018  15:30:00", "ddddd h:nn AMPM") & "'"
    
    'on recupère tous les rdv correspondant aux critères avec la méthode restrict
    Set collectionAppointments = DossierCalendrier.Items.Restrict(sFilter)
    
    'boucle sur tous les rdv trouvés
    For Each oAppointment In collectionAppointments
        'si le sujet correspond on supprime le rdv
        If oAppointment.Subject = "TOTO" Then
            oAppointment.Delete
        End If
    Next

    'Libération des variables.
    Set oAppointment = Nothing
    Set oOutlook = Nothing
MsgBox "RDV supprimé"
Fin_Execution:
    Exit Sub
Err_Execution:
    MsgBox Err.Description, vbExclamation
    Resume Fin_Execution

End If
End If
End Sub