Outlook Macros

Sunset "Tasks"

Sub CreateSunsetTask(timeStr As String, Optional minBeforeSunset As Integer = 45)
    Dim task As Outlook.TaskItem
    Dim atSunset As Date
    Dim beforeSunset As Date

    ' take a walk 45 minutes before actual sunset
    atSunset = CDate(timeStr)
    beforeSunset = DateAdd("n", -minBeforeSunset, atSunset)

    Set task = Application.CreateItem(olTaskItem)
    With task
        .Categories = "Hidden,Personal"
        .Subject = "sunset: go for a walk"
        .Body = "Actual sunset is at " & Format(atSunset, "h:mm AM/PM") & "."
        .DueDate = atSunset
        .ClearRecurrencePattern
        .ReminderTime = beforeSunset
        .ReminderSet = True
        .Sensitivity = olPrivate
        .Save
    End With
End Sub

Then call as CreateSunsetTask("1/1/2009 4:28 PM") in the immediate window.

Go Home

Option Explicit
Sub GoHomeButtonClick()
    DeleteGoHomeEvents
    GoHomeForm.Show
End Sub

Public Sub CreateGoHomeEvent(arrivedAtWork As String, SendEmail As Boolean, ExtraMsg As String)
    Dim appt As Outlook.AppointmentItem
    Dim numHours As Integer
    Dim leaveTime As Date
    Dim arriveTimeStr As String
    Dim leaveTimeStr As String

    Dim email As MailItem
    Dim sendToAddress As String

    sendToAddress = "friend@example.com"
    numHours = 8

    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

    leaveTime = DateAdd("h", numHours, arrivedAtWork)
    arriveTimeStr = Format(arrivedAtWork, "Medium Time")
    leaveTimeStr = Format(leaveTime, "Medium Time")

    Set appt = Application.CreateItem(olAppointmentItem)
    With appt
        .Categories = "Important"
        .Subject = "Go home!"
        .Body = "Arrived at " & arriveTimeStr & "; leave after " & leaveTimeStr & "."
        .Start = leaveTime
        .End = leaveTime
        .BusyStatus = olFree
        .ClearRecurrencePattern
        .ReminderMinutesBeforeStart = 30
        .ReminderSet = True
        .Save
    End With

    If SendEmail Then
        Set email = Application.CreateItem(olMailItem)
        With email
            .To = sendToAddress
            .Subject = "Arrived at " & arriveTimeStr & "; leaving work after " & leaveTimeStr
            .Categories = "Personal"
            .BodyFormat = olFormatPlain

            If Len(ExtraMsg) Then
                .Body = ExtraMsg & vbCrLf & vbCrLf & "--" & vbCrLf & "Me"
            Else
                .Subject = .Subject & " [EOM]"
                .DeleteAfterSubmit = True
            End If

            .Send
        End With
    End If

    Debug.Print "Created a 'Go Home' reminder for " & appt.Start & "."
End Sub

Sub DeleteGoHomeEvents()
    Dim namespace As namespace
    Dim calendar As Folder
    Dim i As Integer
    Dim appts As Items
    Dim appt As AppointmentItem

    Set namespace = Application.GetNamespace("MAPI")
    Set calendar = namespace.GetDefaultFolder(olFolderCalendar)

    Do
        Set appt = calendar.Items.Find("[Subject] = ""Go home!""")
        If Not appt Is Nothing Then
            Debug.Print "Deleting appointment for " & appt.Start
            appt.Delete
        End If
    Loop Until appt Is Nothing
End Sub

Code for "GoHomeForm" user form (also downloadable as [.frm] [.frx]):

Option Explicit

Private Sub RunButton_Click()
    ThisOutlookSession.CreateGoHomeEvent ArrivalTime.Value, SendEmail.Value, ExtraMsg.Value
    GoHomeForm.Hide
End Sub

Private Sub SendEmail_Click()
    ExtraMsg.Enabled = SendEmail.Value
    If SendEmail.Value Then
        ExtraMsg.BackColor = RGB(255, 255, 255)
    Else
        ExtraMsg.BackColor = vbInactiveBorder
    End If
End Sub

Private Sub UserForm_Activate()
    ArrivalTime.Value = DateTime.Now
    SendEmail.Value = True
    ExtraMsg.Value = Empty
End Sub

Then add a custom button to the toolbar that calls GoHomeButtonClick.

To-Do Bar Filters

Due date within 30 days of today and not Hidden categories:

To use, right-click on the To-Do Bar task list and select "Filter...". Open the "SQL" tab and check the checkbox for "Edit these criteria directly." Paste the above SQL statements all as one line into the textarea and click OK.