Option Explicit
'procédure pour supprimer un rdv existant
Sub supprimeRDVCalendrier()
'déclaration des variables
Dim oOutlook As Outlook.Application
Dim oAppointment As Outlook.AppointmentItem
Dim namespaceOutlook As Outlook.Namespace
Dim DossierCalendrier As Outlook.MAPIFolder
'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("30/01/2017 18: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 = "Mon Rdv" Then
oAppointment.Delete
End If
Next
'Libération des variables.
Set oAppointment = Nothing
Set oOutlook = Nothing
Fin_Execution:
Exit Sub
Err_Execution:
MsgBox Err.Description, vbExclamation
Resume Fin_Execution
End Sub