☰

將取消的會議保留在您的日曆上以供參考

tag-icon • tag-icon microsoft-outlook vba microsoft-outlook-2013
將取消的會議保留在您的日曆上以供參考

即使會議被取消，我也喜歡追蹤會議狀況。它可以幫助我回顧針對各種主題的活動，有時還可以解釋為什麼我沒有參加你們的會議。 （EG，「同時舉行了一次定期會議，但主席後來取消了會議並刪除了整個系列，而不僅僅是未來的系列。」）

我嘗試使用發布的腳本slipstick.com因為一些不同的搜尋結果不斷將我指向同一篇文章。然而，它對我來說效果不太好。有更容易的方法嗎？

這是該腳本的副本：

Sub CopyMeetingtoAppointment(oRequest As MeetingItem)

If oRequest.MessageClass <> "IPM.Schedule.Meeting.Canceled" Then
  Exit Sub
End If

Dim oAppt As AppointmentItem
Dim cAppt As AppointmentItem

Set cAppt = oRequest.GetAssociatedAppointment(True)
Set oAppt = Application.CreateItem(olAppointmentItem)

'I added (Rule) to the subject so I could see the rule was working. 
    oAppt.Subject = "(Rule) Canceled: " & cAppt.Subject
    oAppt.Start = cAppt.Start
    oAppt.Duration = cAppt.Duration
    oAppt.Location = cAppt.Location
    oAppt.Display
    oAppt.Save

    Set oAppt = Nothing
    Set cAppt = Nothing
End Sub

你應該設定一個規則來配合它，我認為這部分很好：

螢幕截圖

答案1

經過一番擺弄，我發現了一種更簡單的方法將日曆事件複製到約會項目：使用實際複製方法。我已經在各種場景中對其進行了測試，特別是在定期會議中，它的表現完美無缺。我已將其設定為刪除所有提醒，並在這段時間讓自己自由。此外，我還添加了一條關於誰取消了它的註釋。如果人們可以找到任何其他改進，我會歡迎他們。

Sub CopyMeetingToAppointment(oRequest As MeetingItem)

    'Double-check in case of accidental run
    If oRequest.MessageClass <> "IPM.Schedule.Meeting.Canceled" Then Exit Sub

    'Declare the objects
    Dim oAppt As AppointmentItem
    Dim cAppt As AppointmentItem
    Dim cancelMessage As String

    'Create the objects
    Set cAppt = oRequest.GetAssociatedAppointment(True)
    Set oAppt = cAppt.Copy

    'Create the cancel message
    cancelMessage = vbNewLine & vbNewLine & " - - - - - - - - - - - - - - - - - - - " & vbNewLine & _
        "Meeting was canceled by " & oRequest.SenderName & " <" & oRequest.SenderEmailAddress & "> on " & oRequest.ReceivedTime

    'Modify the copied appointment
    With oAppt
        If UCase(Left(.Subject, 6)) = "COPY: " Then .Subject = Mid(.Subject, 7)
        .Subject = "[BKP] " & .Subject
        .Body = .Body & cancelMessage
        .ReminderSet = False
        .BusyStatus = olFree
        .Save
    End With

    'Cleanup
    Set oAppt = Nothing
    Set cAppt = Nothing

End Sub

相關內容