Outlook: Как оставить отмененное собрание в календаре как организатор?

Author Sun Last modified 2025-08-26

В Outlook, будучи организатором встречи, при её отмене она автоматически удаляется из календаря. В некоторых случаях вы можете захотеть сохранить отмененные встречи в календаре для пометок. Однако в Outlook нет встроенных функций, которые могут справиться с этой задачей. В этом руководстве представлены два кода VBA для сохранения встречи как события при её отмене.

Коды VBA для копирования отмененной встречи как события

Коды VBA для копирования отмененной встречи как события

Вот два кода для отмены встречи и одновременного копирования и вставки её как события.

Примечание: перед активацией кода убедитесь, что эти две опции включены:

Включите Outlook, нажмите Файл > Параметры, в окне параметров Outlook выберите вкладку Центр управления безопасностью, затем нажмите Настройки центра управления безопасностью. В окне Центр управления безопасностью перейдите на вкладку Настройки макросов, отметьте Включить все макросы (не рекомендуется; потенциально опасный код может быть выполнен) и Применить настройки безопасности макросов к установленным надстройкам. Нажмите ОК > ОК, чтобы закрыть окна. Перезапустите Outlook.

1. Переключитесь в представление Календарь в Outlook и выберите встречу, которую хотите отменить. Нажмите клавиши 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 , теперь выбранная встреча отменена, и создано новое событие с названием Отменено & тема.

Если вы хотите скопировать и вставить встречу как событие в другой календарь, а затем отменить встречу, используйте следующий код:

Код: Скопировать встречу как событие в другом календаре и отменить её

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 , появится диалоговое окно Выбрать папку, где вы сможете выбрать папку календаря для вставки события, затем нажмите ОК.