删除 Outlook 日历约会不会释放聊天室

Question

我正在尝试使用下面的代码从Access VBA中删除Outlook日历中的未来约会。 代码工作正常，但这些约会是使用房间(资源(设置的，删除 MY 日历中的约会不会在资源日历中删除它。 我该如何解决这个问题？

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 编写了一个宏，用于从资源日历中删除取消的约会：

' 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("MailboxNameCalendar")  
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 

让我知道这是否从资源日历中删除了取消的约会 -

~乔尔