如何删除约会



我有一段代码,应该在未来的所有约会中循环使用;如果它们符合特定条件,则将它们从日历中删除。

Sub DeleteFutureImportedCalendarItems()
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim objAppointment As Outlook.AppointmentItem
    Dim strSubject As String
    Dim strLocation As String
    Dim dteStartDate As Date
    Dim Category As String
     
    '******************************** Set Criteria for DELETION here ********************************
    strSubject = "[Imported]"
    strLocation = "AC"
    dteStartDate = Date
    Category = "Yellow Category"
    '************************************************************************************************
     
    Set objOutlook = Outlook.Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(olFolderCalendar)
     
    For Each objAppointment In objFolder.Items
    
      If Right(objAppointment.Subject, 10) = strSubject And objAppointment.Location = strLocation And _
         objAppointment.Start >= dteStartDate And objAppointment.Categories = Category  Then
           objAppointment.Delete
          
      End If
    Next
End Sub

这不会删除所有符合条件的约会。如果我多次运行代码,每次都会获得更多,但我必须运行5或6次才能获得所有代码。

删除项目会更改集合。循环从倒数到1:

set oItems = objFolder.Items
for i = oItems.Count to 1 step -1 do
  set objAppointment = oItems.Item(I)
  ...

最新更新