Outlook: как оставить отменённую встречу в календаре, будучи её организатором?

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

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

---

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

Ниже приведены два кода, которые одновременно отменяют встречу и создают её копию в виде события.

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

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

1. Перейдите в представление календаря Outlook и выберите встречу, которую хотите отменить. Нажмите Alt+F11, чтобы открыть окно Microsoft Visual Basic для приложений.

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

Теперь встреча отменена и сохранена как событие в выбранной вами папке календаря.