"Go Home" Outlook Reminder

The Problem

Now that Forrest has moved up here, I have to change my work schedule a bit. When I had no one to go home to after work, I didn't really worry about how long I stayed in the office. Even after I put in my 8 hours, I'd be inclined to stay, reading the Intarwebs. I mean, if I was just going to be internetting when I got home anyway, what difference did it make whether I did it at home or at work?

But now, it's sad if I don't get home until 9 or 10 in the evening, tired enough to want to go straight to sleep, and I haven't seen Forrest all day. So I need to save my time-wasting (such as blog posts, hrm...) for when I'm at home, where at least we can waste time together. :)

The Geeky Semi-Solution

I will lose track of time, though, if left to my own devices. So I wrote myself a little custom "Go Home" button in Outlook, which creates an alarm 8 hours from when I get to work, that pops up and tells me to go home.

Partly to document it, and partly to help out anyone else who might like to program something similar, here's how I did it. In the Visual Basic Editor (Alt-F11 from within Outlook), I created a new function:

Sub CreateGoHomeEvent()
    Dim message, title, defaultValue As String
    Dim arrivedAtWork As String
    Dim appt As Outlook.AppointmentItem
    
    message = "When did you get to work today?"
    title = "Start Time"
    defaultValue = DateTime.Now
    
    arrivedAtWork = InputBox(message, title, defaultValue)
    If arrivedAtWork = "" Then
        ' If the returned value is blank, the user hit cancel.
        Debug.Print "Cancelling; did not create an appointment."
        Exit Sub
    End If

    Set appt = Application.CreateItem(olAppointmentItem)
    With appt
        .Categories = "Important!,Processed"
        .Subject = "Go home, it's been 8 hours!"
        .Start = DateAdd("h", 8, arrivedAtWork)
        .End = .Start
        .BusyStatus = olFree
        .ClearRecurrencePattern
        .ReminderMinutesBeforeStart = 15
        .ReminderSet = True
        .Save
    End With
    
    Debug.Print "Created a 'Go Home' reminder for " & appt.Start & "."
End Sub

Then I customized the Outlook toolbar to include a button that calls this new macro. It prompts me for the time I got to work, defaulting to the current time. If I click the OK button, it creates a new reminder task with an alarm that goes off 8 hours from that time. It's simple, but useful. Here's a screenshot of it in action, with the "Go Home" button on the far right of the toolbar, and a red rectangle in the "To-Do Bar" being the task sitting there, waiting to trigger its pop-up window alarm:

Update, Wednesday 11:35 AM: Added in the missing code to actually trigger the reminder itself. Setting ReminderMinutesBeforeStart = 15 is not enough; you also need to set ReminderSet = True for the reminder to trigger.