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