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