Outlook: Πώς να διατηρήσετε την ακύρωση της σύσκεψης στο ημερολόγιο ως διοργανωτής;

Στο Outlook, ως διοργανωτής σύσκεψης, όταν ακυρώσετε τη σύσκεψη, η σύσκεψη θα διαγραφεί αυτόματα από το ημερολόγιο. Σε ορισμένες περιπτώσεις, μπορεί να θέλετε να διατηρήσετε τις ακυρωμένες συσκέψεις στο ημερολόγιο για να σημειώσετε. Ωστόσο, δεν υπάρχουν ενσωματωμένες δυνατότητες στο Outlook που να μπορούν να χειριστούν αυτήν την εργασία. Σε αυτό το σεμινάριο, παρέχει δύο κωδικούς VBA για τη διατήρηση της συνάντησης ως ραντεβού κατά την ακύρωση.

Κωδικοί VBA για αντιγραφή ακυρωμένης συνάντησης ως ραντεβού

Κωδικοί VBA για αντιγραφή ακυρωμένης συνάντησης ως ραντεβού

Ακολουθούν δύο κωδικοί για την ακύρωση της συνάντησης και την ταυτόχρονη αντιγραφή και επικόλληση ως ραντεβού.

Σημείωση: προτού ενεργοποιήσετε τον κωδικό, βεβαιωθείτε ότι έχουν επιλεγεί αυτές οι δύο επιλογές:

Ενεργοποιήστε το Outlook, κάντε κλικ στο Αρχεία > Επιλογές, στο παράθυρο Επιλογές του Outlook, κάντε κλικ Κέντρο αξιοπιστίας καρτέλα και κάντε κλικ στο κουμπί Ρυθμίσεις Κέντρου αξιοπιστίας, στη συνέχεια, στο παράθυρο Κέντρο αξιοπιστίας, κάντε κλικ Ρυθμίσεις μακροεντολών καρτέλα, ελέγξτε Ενεργοποίηση όλων των μακροεντολών (δεν συνιστάται. Μπορεί να εκτελεστεί επικίνδυνος κώδικας) και Εφαρμόστε ρυθμίσεις ασφαλείας μακροεντολών στα εγκατεστημένα πρόσθετα επιλογές. Κάντε κλικ OK > OK να κλείσουν τα παράθυρα. επανεκκίνηση Αποψη.

1. Μεταβείτε στην προβολή Ημερολογίου του Outlook και επιλέξτε τη σύσκεψη που θέλετε να ακυρώσετε Πατήστε άλλος + 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 πλήκτρο, εμφανίζεται ένα παράθυρο διαλόγου Επιλογή φακέλου για να επιλέξετε έναν φάκελο ημερολογίου για να επικολλήσετε τη συνάντηση και, στη συνέχεια, κάντε κλικ στο OK.