Sub Relist_Done()
    ' Mike Miller - mikem@computer.org
    ' Copyright Mike Miller 2005
    ' http://3cats.us/
    ' Revision 1.2
    '
    ' This is a macro for Microsoft Outlook 2003 that performs 2 basic functions
    ' on tasks that have some extra text at the *end* of the subject line of the
    ' form "[rate category1 category2]" (the two category values are optional,
    ' but I think they provide a lot of functionality) and it performs the
    ' following actions on these tasks:
    '
    ' 1. If the task is complete, then move the task to the category1 category and
    '    set the due date to be the date marked complete + rate days and mark the
    '    task as not started
    ' 2. If the task is not complete, the due date is >= today, then move the
    '    task to the category2 category to draw attention to it.
    '
    ' After performing these tasks, if it has made any changes, it will bring up
    ' a message box describing the actions that it took. If no actions were
    ' taken, a message box is not shown. If you don't like the message box
    ' comment out the "MsgBox" line down near the bottom of this macro.
    '
    ' The usage model is that I had some small tasks that I needed to do on a
    ' highly regular basis, and basically wanted them to "recur" but outlook's
    ' recur mechanism leaves the item visible at all times, which is bad. For
    ' example, I want to water my plants every other day, so I have:
    '    Water plants [2 Tickler, Home]
    ' So that when mark it done, it drops off the list, and goes into the tickler
    ' category until 2 days elapse and then it pops up in the home category
    ' again to remind me to water my plants.
    '
    ' Eventually, I'd like to have more complicated expressions for "rate" like
    ' "MWF" or "2Sun" to get the recurrence to happen on particular days or the
    ' 2nd Sunday from now. Unfortunately, without regular expression support in
    ' VBA, parsing such items will be tricky, and for the first pass, I can live
    ' with just having #of days.
    '
    ' Note on Outlook macro permissions: Outlook has an unusual behavior where
    ' it will let you write and run macros, but if you quit and restart, it applies
    ' a different set of permissions rules to the macros that you wrote previously.
    ' The result is a message box claiming that macros are disabled in outlook.
    ' To get around this, go to Tools -> Macro -> Security and either lower the
    ' setting to medium, or go through the process of signing your macros (the help
    ' on this isn't too bad). Also it seemed to me that you have to restart outlook
    ' for the security settings to actually be lowered.
    '
    Dim myolApp As Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myFolderTasks As Outlook.MAPIFolder
    Dim myItems As Outlook.Items
    Dim myItem As TaskItem
    Dim myString As String
    Dim myStringArray() As String
    Dim myRecur As String
    Dim myHiddenCategory As String
    Dim myActiveCategory As String
    Dim RecoveredString As String
    Dim PromotedString As String
    Dim ReportString As String
    
    RecoveredString = ""
    PromotedString = ""
    
    Set myolApp = CreateObject("Outlook.Application")
    Set myNamespace = myolApp.GetNamespace("MAPI")
    Set myolApp.ActiveExplorer.CurrentFolder = myNamespace.GetDefaultFolder(olFolderTasks)
    Set myFolderTasks = myolApp.ActiveExplorer.CurrentFolder
    
    For Each myItem In myFolderTasks.Items
        ' We check for subject = "" as protection against mid() on zero-length strings
        If (myItem.Subject = "") Then
            GoTo Relist_Skip_Item
        End If
        
        'See if this task has [] in it
        myString = Mid(myItem.Subject, Len(myItem.Subject), 1)
        myStringArray = Split(myItem.Subject, "[")
        If ((myString <> "]") Or (UBound(myStringArray) <> 1)) Then
            GoTo Relist_Skip_Item
        End If
        
        ' OK, this task appears to have stuff we are interested in, process
        ' what is between the [] and assign internal variables to the values
        ' for readability. Note that the 2 category options are optional.
        myStringArray = Split(myStringArray(1), " ")
        myRecur = myStringArray(0)
        If (UBound(myStringArray) > 0) Then
            myHiddenCategory = myStringArray(1)
        Else
            myHiddenCategory = ""
        End If
        If (UBound(myStringArray) > 1) Then
            myActiveCategory = Mid(myStringArray(2), 1, (Len(myStringArray(2)) - 1))
        Else
            myActiveCategory = ""
        End If
        
        If (myItem.Status = olTaskComplete) Then
            ' Here is were we reclaim a completed task and stash it off in the hidden
            ' tickler or waiting category so we don't have to look at it.
            myItem.DueDate = myItem.DateCompleted + Int(myRecur)
            myItem.Status = olTaskNotStarted
            If (myHiddenCategory <> "") Then
                myItem.Categories = myHiddenCategory
            End If
            RecoveredString = RecoveredString & "  " & myItem.Subject & Chr(10)
            myItem.Save
        Else
            ' If the user provided us with an active category and the due date is
            ' today, then "promote" the task to the active category so it gets the
            ' right visiblity
            If (myActiveCategory <> "") Then
                If ((myItem.DueDate <= Date) And (myItem.Categories <> myActiveCategory)) Then
                    myItem.Categories = myActiveCategory
                    PromotedString = PromotedString & "  " & myItem.Subject & Chr(10)
                    myItem.Save
                End If
            End If
        End If
    ' yes, I know gotos are evil, but I don't know of the break functionality
    ' so I'm not nested so deep I can't make heads or tails of where I am...
Relist_Skip_Item:
    Next
    
    ' Here is where we build a MsgBox if the script has changed anything to let the
    ' user know what has changed. This is particularly key for "promoted" items.
    ' If you don't like getting the little box, just comment out the line that
    ' starts with "MsgBox"
    ReportString = ""
    If (Len(RecoveredString) > 0) Then
        ReportString = "Recovered the following tasks:" & Chr(10) & RecoveredString & Chr(10)
    End If
    If (Len(PromotedString) > 0) Then
        ReportString = ReportString & "Promoted the following tasks:" & Chr(10) & PromotedString
    End If
    If (Len(ReportString) > 0) Then
        MsgBox (ReportString)
    End If
    
End Sub