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("\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
让我知道这是否会从资源日历中删除已取消的约会-
~乔尔