删除Outlook日历约会不会释放空间

Question

我试图从下面的代码中从Access VBA中删除Outlook日历中将来的约会。代码工作正常，但这些约会已使用房间（资源）设置，并且删除我的日历中的约会不会在资源日历中将其删除。我该如何解决这个问题？

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

黛安Poremsky has written a macro通过去并删除取消从资源压延约会：

' 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 

让我知道，如果从资源压延删除取消预约 -

〜约尔