Sub Relist_Done()
' Mike Miller - [email]mikem@computer.org[/email]
' Copyright Mike Miller 2005
' http://3cats.us/
'
' 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.
'
' 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.
'
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
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
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
MsgBox "comparing " & myItem.DueDate & " with " & Date
If (myItem.DueDate <= Date) Then
myItem.Categories = myActiveCategory
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
End Sub
Tried to work on a filter to hide them, but couldn't quite figure it out. The hiding worked, but couldn't get them to display on the date due. This sounds like just the ticket!