使用有效负载共享导出日历
Microsoft Outlook 包括通过使用附加到 MailItem 的 iCalendar (.ics) 文件与其他用户共享日历信息的功能。 CalendarSharing 对象用于从包含日历项的文件夹生成 iCalendar 文件,以及生成 iCalendar 文件所附加到的 MailItem。
本示例将使用 CalendarSharing 项目与一个收件人共享接下来七天的空闲/忙碌信息:
本示例使用 NameSpace 对象的 GetDefaultFolder 方法来获取对当前用户的 "日历" 默认文件夹的 Folder 对象引用。
它使用 Folder 对象的 GetCalendarExporter 方法为文件夹创建 CalendarSharing 对象引用。
接下来,本示例将对 CalendarSharing 对象设置下列属性,以限制该对象导出信息的范围和级别:
设置 CalendarDetail 属性,以便将每个日历项目的信息仅限制为空闲/忙碌信息。
设置 RestrictToWorkingHours 属性,将日历项目限制为工作小时之内的项目。
设置 IncludeAttachments 属性,排除该对象导出的日历项目的任何附件。
设置 IncludePrivateDetails 属性,排除该对象导出的任何个人日历项目的详细信息。
然后,它调用 CalendarSharing 对象的 ForwardAsICal 方法,将日历项目导出到 iCalendar 文件,并创建一个 MailItem 对象,并将 iCalendar 文件作为附件。 olCalendarMailFormat 枚举的 olCalendarMailFormatDailySchedule 常量与 ForwardAsICal 方法一起使用,以指示 MailItem 的正文应包含未来七天的闲/忙信息(HTML 格式)。
最后,调用新创建的 MailItem 对象的 Recipients 集合的 Add 方法以添加指定的收件人,并使用 Send 方法发送 MailItem。
Public Sub ShareWorkCalendarByPayload()
Dim oNamespace As NameSpace
Dim oFolder As Folder
Dim oCalendarSharing As CalendarSharing
Dim oMailItem As MailItem
On Error GoTo ErrRoutine
' Get a reference to the Calendar default folder
Set oNamespace = Application.GetNamespace("MAPI")
Set oFolder = oNamespace.GetDefaultFolder(olFolderCalendar)
' Get a reference to a CalendarSharing object for that
' folder.
Set oCalendarSharing = oFolder.GetCalendarExporter
' Set the CalendarSharing object to restrict
' the information shared in the iCalendar file.
With oCalendarSharing
' Send free/busy information only.
.CalendarDetail = olFreeBusyOnly
' Send information for the next seven days.
.startDate = Now
.endDate = DateAdd("d", 7, Now)
' Restrict information to working hours only.
.RestrictToWorkingHours = True
' Exclude attachments and private information.
.IncludeAttachments = False
.IncludePrivateDetails = False
End With
' Get the mail item containing the iCalendar file
' and calendar information.
Set oMailItem = oCalendarSharing.ForwardAsICal( _
olCalendarMailFormatDailySchedule)
' Send the mail item to the specified recipient.
With oMailItem
.Recipients.Add "someone@example.com"
.Send
End With
EndRoutine:
On Error GoTo 0
Set oMailItem = Nothing
Set oCalendarSharing = Nothing
Set oFolder = Nothing
Set oNamespace = Nothing
Exit Sub
ErrRoutine:
Select Case Err.Number
Case 287 ' &H0000011F
' The user denied access to the Address Book.
' This error occurs if the code is run by an
' untrusted application, and the user chose not to
' allow access.
MsgBox "Access to Outlook was denied by the user.", _
vbOKOnly, _
Err.Number & " - " & Err.Source
Case -2147467259 ' &H80004005
' Export failed.
' This error typically occurs if the CalendarSharing
' method cannot export the calendar information because
' of conflicting property settings.
MsgBox Err.Description, _
vbOKOnly, _
Err.Number & " - " & Err.Source
Case -2147221233 ' &H8004010F
' Operation failed.
' This error typically occurs if the GetCalendarExporter method
' is called on a folder that doesn't contain calendar items.
MsgBox Err.Description, _
vbOKOnly, _
Err.Number & " - " & Err.Source
Case Else
' Any other error that may occur.
MsgBox Err.Description, _
vbOKOnly, _
Err.Number & " - " & Err.Source
End Select
GoTo EndRoutine
End Sub
支持和反馈
有关于 Office VBA 或本文档的疑问或反馈? 请参阅 Office VBA 支持和反馈,获取有关如何接收支持和提供反馈的指南。