A exclusão de Compromisso de calendário do Outlook não libera Quarto

Question

Eu estou tentando excluir compromissos futuros no meu calendário do Outlook a partir do Access VBA, com o código abaixo.O código funciona ok, MAS os Compromissos que foram configurados utilizando um quarto (de recursos), e excluindo o compromisso no MEU calendário não eliminá-lo no calendário do recurso.Como posso corrigir isso ?

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 tem escrito uma macro que passa e remove cancelado compromissos do recurso de calendário:

' 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 

Deixe-me saber se de que remove o cancelado compromissos do calendário de recurso -

~JOL