Deleting Outlook calendar Appointment does not release Room - vba

Question

I am trying to delete future appointments in my Outlook calendar, from Access VBA, with the code below. The code works ok, BUT those Appointments have been set up using a room (resource), and deleting the appointment in MY calendar does not delete it in the resource calendar. How can I fix that ?
Sub NoFuture()
'delete any future appointment
Dim olApp As Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olRecItems
Dim olFilterRecItems
Dim olItem As Outlook.AppointmentItem, strFilter As String
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olRecItems = olNs.GetDefaultFolder(olFolderCalendar)
strFilter = "[Start] > '" & Format(Date + 1, "mm/dd/yyyy") & "'"
Set olFilterRecItems = olRecItems.Items.Restrict(strFilter)
For Each olItem In olFilterRecItems
olItem.Delete
Next olItem
Set olRecItems = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub

Answer 1

Diane Poremsky has written a macro that goes through and removes cancelled appointments from the resource calender:
' A subroutine to remove cancelled appointments.
Sub RemoveCanceledAppointments()
'Form variables.
Dim OutLookResourceCalendar As Outlook.MAPIFolder, OutLookAppointmentItem As Outlook.AppointmentItem, IntegerCounter As Integer
'This sets the path to the resource calender.
Set OutLookResourceCalendar = OpenMAPIFolder("\MailboxName\Calendar")
For IntegerCounter = OutLookResourceCalendar.Items.Count To 1 Step -1
Set OutLookAppointmentItem = OutLookResourceCalendar.Items(IntegerCounter)
If Left(OutLookAppointmentItem.Subject, 9) = "Canceled:" Then
OutLookAppointmentItem.Delete
End If
Next
Set OutLookAppointmentItem = Nothing
Set OutLookResourceCalendar = Nothing
End Sub
' A function for the folder path.
Function OpenMAPIFolder(FolderPathVar)
Dim SelectedApplication, FolderNameSpace, SelectedFolder, FolderDirectoryVar, i
Set SelectedFolder = Nothing
Set SelectedApplication = CreateObject("Outlook.Application")
If Left(FolderPathVar, Len("\")) = "\" Then
FolderPathVar = Mid(FolderPathVar, Len("\") + 1)
Else
Set SelectedFolder = SelectedApplication.ActiveExplorer.CurrentFolder
End If
While FolderPathVar <> ""
' Backslash var.
i = InStr(FolderPathVar, "\")
'If a Backslash is present, acquire the directory path and the folder path...[i].
If i Then
FolderDirectoryVar = Left(FolderPathVar, i - 1)
FolderPathVar = Mid(FolderPathVar, i + Len("\"))
Else
'[i] ...or set the path to nothing.
FolderDirectoryVar = FolderPathVar
FolderPathVar = ""
End If
' Retrieves the folder name space from the Outlook namespace, unless a folder exists... [ii].
If IsNothing(SelectedFolder) Then
Set FolderNameSpace = SelectedApplication.GetNamespace("MAPI")
Set SelectedFolder = FolderNameSpace.Folders(FolderDirectoryVar)
Else
' [ii] in which case the the existing folder namespace is used.
Set SelectedFolder = SelectedFolder.Folders(FolderDirectoryVar)
End If
Wend
Set OpenMAPIFolder = SelectedFolder
End Function
' A function to check too see if there is no set namespace for the folder path.
Function IsNothing(Obj)
If TypeName(Obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function
Let me know if that removes the cancelled appointments from the resource calender -
~JOL