Outlook: Hogyan lehet a megbeszélés lemondását a naptárban tartani szervezőként?

Az Outlook programban értekezletszervezőként az értekezlet törlésekor az értekezlet automatikusan törlődik a naptárból. Bizonyos esetekben érdemes megőrizni a törölt értekezleteket a naptárban, hogy néhány jelölést elvégezhessen. Az Outlookban azonban nincsenek olyan beépített szolgáltatások, amelyek képesek kezelni ezt a feladatot. Ebben az oktatóanyagban két VBA-kódot biztosít az értekezlet találkozóként való megtartásához lemondás közben.

VBA-kódok a lemondott értekezlet találkozóként való másolásához

VBA-kódok a lemondott értekezlet találkozóként való másolásához

Íme két kód az értekezlet lemondására, valamint a találkozó egyidejű másolására és beillesztésére.

Megjegyzés: a kód engedélyezése előtt győződjön meg arról, hogy a következő két lehetőség be van jelölve:

Engedélyezze az Outlook alkalmazást, kattintson a gombra filé > Opciók, az Outlook Beállítások ablakában kattintson a gombra Trust Center lapot, és kattintson a gombra Trust Center beállítások, majd a Bizalmi központ ablakában kattintson a gombra Makróbeállítások fül, csekk Minden makró engedélyezése (nem ajánlott; potenciálisan veszélyes kód futtatható) és a Alkalmazza a makró biztonsági beállításait a telepített bővítményekre opciók. Kattints OK > OK becsukni az ablakokat. Újraindítás Outlook.

1. Gyorsan lépjen az Outlook naptár nézetébe, és válassza ki a megszakítani kívánt értekezletet Nyomja meg a gombot más + F11 kulcsok a Microsoft Visual Basic for Applications ablak engedélyezéséhez.

2. kettyenés betétlap > Modulok új üres modul beillesztéséhez. Ezután másolja ki és illessze be az alábbi kódot.

Kód: Másolja a találkozót találkozóként, és mondja le

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. kettyenés futás vagy nyomja meg a gombot F5 gombot, most a kiválasztott találkozót törölték, és egy új találkozót töröltek és tárgy.

Ha az értekezletet találkozóként szeretné másolni és beilleszteni egy másik naptárba, majd törölni szeretné az értekezletet, használja az alábbi kódot:

Kód: Másolja a találkozót találkozóként egy másik naptárba, és mondja le

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

Kattints futás vagy nyomja meg a gombot F5 gombot, egy Mappa kiválasztása párbeszédpanel jelenik meg, ahol kiválaszthatja a naptármappát a találkozó beillesztéséhez, majd kattintson az OK gombra.