Suppression de la nomination du calendrier Outlook ne libère pas la pièce

Question

J'essaie de supprimer des rendez-vous futurs dans mon calendrier Outlook, de l'accès VBA, avec le code ci-dessous.Le code fonctionne bien, mais ces rendez-vous ont été mis en place à l'aide d'une salle (ressource) et de supprimer le rendez-vous dans mon calendrier ne le suppriment pas dans le calendrier des ressources.Comment puis-je résoudre ce problème?

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 PorSky a écrit une macro qui passe et supprime les rendez-vous annulés du calendrier des ressources:

' 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 

Faites-moi savoir si cela supprime les rendez-vous annulés du calendrier des ressources -

~ jol