Outlook：作为会议组织者，如何在日历中保留已取消的会议？

在 Outlook 中，作为会议组织者，取消会议后，会议会自动从日历中移除。但在某些情况下，您可能希望将已取消的会议保留在日历中以便标记。然而，Outlook 并未内置此功能。本教程为您提供了两段 VBA 代码，帮助您在取消会议的同时，将其以日程事项的形式保留在日历中。

用于将已取消的会议复制为日程事项的 VBA 代码

---

用于将已取消的会议复制为日程事项的 VBA 代码

以下提供了两段代码，可在取消会议的同时，将其内容复制并粘贴为日程事项。

注意：在启用代码前，请确保已勾选以下两个选项：

启动 Outlook，点击文件 > 选项，在 Outlook 选项窗口中，点击信任中心选项卡，再点击信任中心设置。在信任中心窗口中，点击宏设置选项卡，勾选启用所有宏（不推荐；可能会运行有潜在危险的代码）和将宏安全性设置应用于已安装的加载项。点击确定 > 确定 关闭窗口。重启 Outlook，即可完成设置。

1. 切换到日历视图，选中您要取消的会议后，按下 Alt+F11 组合键，即可打开 Microsoft Visual Basic for Applications 窗口。

2. 点击插入>模块，即可插入一个新的空模块。然后将以下代码复制并粘贴到该模块中。

代码：将会议以日程事项方式复制并取消

Sub CopyMeetingAsAppointmentBeforeCancel()
'UpdatebyExtendoffice20221129
Dim xAppointmentItem As AppointmentItem
Dim xMeetingItem As AppointmentItem
On Error Resume Next
Set xMeetingItem = GetCurrentItem()
Set xAppointmentItem = Application.CreateItem(olAppointmentItem)
With xAppointmentItem
  .Subject = "Canceled: " & xMeetingItem.Subject
  .Start = xMeetingItem.Start
  .Duration = xMeetingItem.Duration
  .Location = xMeetingItem.Location
  .Body = xMeetingItem.Body
  .Save
  .Move Application.ActiveExplorer.CurrentFolder
End With
With xMeetingItem
  .MeetingStatus = olMeetingCanceled
  .Send
  .Delete
End With
Set xAppointmentItem = Nothing
Set xMeetingItem = Nothing
End Sub

Function GetCurrentItem() As Object
  On Error Resume Next
  Select Case TypeName(Application.ActiveWindow)
    Case "Explorer"
      Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
      Set GetCurrentItem = Application.ActiveInspector.CurrentItem
  End Select
End Function

3. 点击运行按钮或按下 F5 键，即可取消当前选中的会议，并自动生成一个名为“Cancled & subjet”的新约会。

如果您想将会议以日程事项方式复制粘贴到其他日历后再取消会议，请使用以下代码：

代码：将会议以日程事项方式复制到其他日历并取消

Sub CopyMeetingAsAppointmentToCalenderBeforeCancel()
'Updatebyextendoffice20221129
Dim xDestCalendar As Outlook.MAPIFolder
Dim xNameSpace As Outlook.NameSpace
Dim xAppointmentItem As AppointmentItem
Dim xMeetingItem As AppointmentItem
On Error Resume Next
Set xNameSpace = Application.GetNamespace("MAPI")
Set xDestCalendar = xNameSpace.PickFolder
If xDestCalendar.DefaultItemType <> olAppointmentItem Then
  MsgBox "Please Select calendar folder. ", vbOKOnly + vbInformation, "Kutools for Outlook"
  Exit Sub
End If
Set xMeetingItem = GetCurrentItem()
Set xAppointmentItem = Application.CreateItem(olAppointmentItem)
With xAppointmentItem
  .Subject = "Canceled: " & xMeetingItem.Subject
  .Start = xMeetingItem.Start
  .Duration = xMeetingItem.Duration
  .Location = xMeetingItem.Location
  .Body = xMeetingItem.Body
  .Save
  .Move xDestCalendar
End With
With xMeetingItem
  .MeetingStatus = olMeetingCanceled
  .Send
  .Delete
End With
Set xDestCalendar = Nothing
Set xNameSpace = Nothing
Set xAppointmentItem = Nothing
Set xMeetingItem = Nothing
End Sub

Function GetCurrentItem() As Object
  On Error Resume Next
  Select Case TypeName(Application.ActiveWindow)
    Case "Explorer"
      Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
      Set GetCurrentItem = Application.ActiveInspector.CurrentItem
  End Select
End Function

点击运行按钮或按下 F5 键，即可弹出选择文件夹对话框，方便您选择一个日历文件夹粘贴日程事项，最后点击确定。

当前会议已被取消，并已作为日程事项复制粘贴到您指定的日历文件夹中。