A Slipstick.com visitor asked how to assign a category to his appointments automatically, as soon as they are over.
You can do this using a macro with a trigger, such as the meetings own reminder or the next appointment reminder, that will kick off the macro. The other option is to run a macro manually, such as at the end of the day.
If you don't assign color categories to any appointments, you can use a custom view to apply automatic formatting colors to old appointments. Category colors take precedence, so this method only works on non-categorized appointments and events.
This macro is triggered by an appointment reminder and checks all appointments with End times between Now and 3 days ago. If you don't restrict it to recent events, the macro will check every appointment, which could take several minutes. (I used 3 days to cover days when there are no appointments.)
To keep any existing categories, use Appt.Categories = "Completed;" & Appt.Categories or Appt.Categories = "Completed" to erase categories and replace them with the Completed category.
To use the Appointment start date, use Appt.Start < Now().
Set the category when a reminder fires
This macro code goes into ThisOutlookSession. When an appointment reminder fires, it runs. To run it when any reminder fires, remove the If... End If code block.
Private Sub Application_Reminder(ByVal Item As Object) If Item.MessageClass <> "IPM.Appointment" Then Exit Sub End If Dim Appt As Object Set Items = Session.GetDefaultFolder(olFolderCalendar).Items For Each Appt In Items On Error Resume Next If Appt.End < Now() And Appt.End> Now() - 3 Then Appt.Categories = "Completed;" & Appt.Categories Appt.ReminderSet = False Appt.Save End If Next Set Appt = Nothing End Sub
Set the category using a macro
This macro can be placed in a module or in ThisOutlookSession and assigned to a button on the ribbon or QAT for easy access.
If you want to make the change at the end of the day, you can run this macro to change all appointments with a start time before now.
Public Sub AddCategory() Dim Appt As Object Set Items = Session.GetDefaultFolder(olFolderCalendar).Items For Each Appt In Items On Error Resume Next If Appt.End < Now() Then With Appt .Categories = "Completed" .ReminderSet = False .Save End with End If Next Set Appt = Nothing End Sub