Create Automatically Follow-Up Tasks

This sample automatically creates another task item as soon as you flag the previous one as complete. Paste this first part of code into the module 'ThisOutlookSession'.

  How to add macros to Outlook

Private m_TaskList As MyTaskList

Public Sub AddFirstTaskItem()
  m_TaskList.AddFirstTaskItem
End Sub

Private Sub Application_Startup()
  Set m_TaskList = New MyTaskList
End Sub

Now click Insert -> Class Module. Press f4, and name the module 'MyTask'. Paste the following code into the module.

Public Subject As String

Public ID As String
Public NextID As String
Public BeginDateOffset As Long
Public DueDateOffset As Long

Add another class module the same way, and name it 'MyTaskList'.

You can create your list of tasks in the first procedure (CreateTaskList). Each row is for one task item. The order is important, the first one comes first, then the secoond, etc. When you later flag the first task as completed, then the second one from this list will be created, and so on. In this simple example you only need to enter three values for each task:

1. Subject
2. BeginDateOffset: Enter here how many days later the task should begin.
3. DueDateOffset: Enter here how many days later the task shoud be due.

In this sample: The first task begins on the same day when you create the task (offset 0), and it will be due two days later (offset 2). The second task begins on the same day when you mark the previous task as completed (offset 0), and it will be due on the very same day (offset 0). The third task will begin seven days after you've completed the second task, and it will be due the next day.

Use the procedure 'AddFirstTaskItem' in order to create the very first task item, which you can call, for instance, by pressing alt+f8. Calling this procedure ensures the task will be created with all the necessary information, so the entire mechanism will work properly. This first task item will be displayed so you can change it, while all the following tasks won't be displayed but saved directly.

Private WithEvents Explorer As Outlook.Explorer
Private WithEvents Task As Outlook.TaskItem
Private TaskList As VBA.Collection

Private Sub CreateTaskList(List As VBA.Collection)
  List.Add Array("task 1", 0, 2)
  List.Add Array("task 2", 0, 0)
  List.Add Array("follow-up task 2", 7, 1)
End Sub

Public Sub AddFirstTaskItem()
  Dim Task As Outlook.TaskItem
  Set Task = AddTaskItem(TaskList(1), Date)
  Task.Display
End Sub

Private Function AddTaskItem(mt As MyTask, ByVal StartDate As Date) As Outlook.TaskItem
  Dim Task As Outlook.TaskItem
  Set Task = Application.CreateItem(olTaskItem)
  Task.Subject = mt.Subject
  Task.StartDate = DateAdd("d", mt.BeginDateOffset, StartDate)
  Task.DueDate = DateAdd("d", mt.DueDateOffset, Task.StartDate)
  Task.BillingInformation = mt.ID
  Set AddTaskItem = Task
End Function

Private Sub Class_Initialize()
  Dim List As New VBA.Collection
  Dim item As Variant
  Dim mt As MyTask
  Dim i As Long
  Set TaskList = New VBA.Collection
  CreateTaskList List
  For i = 1 To List.Count
    item = List(i)
    Set mt = New MyTask
    mt.ID = CStr(i)
    If i < List.Count Then
      mt.NextID = CStr(i + 1)
    End If
    mt.Subject = item(0)
    mt.BeginDateOffset = item(1)
    mt.DueDateOffset = item(2)
    TaskList.Add mt, CStr(i)
  Next
  Set Explorer = Application.ActiveExplorer
End Sub

Private Sub Task_PropertyChange(ByVal Name As String)
  If Name = "DateCompleted" Then
    If Task.PercentComplete = 100 And Task.DateCompleted <> "01.01.4501" Then
      Dim ID As String
      Dim mt As MyTask
      ID = Task.BillingInformation
      If Len(ID) Then
        On Error Resume Next
        Set mt = TaskList(ID)
        If Not mt Is Nothing Then
          If Len(mt.NextID) Then
            Set mt = TaskList(mt.NextID)
            If Not mt Is Nothing Then
              Dim NextTask As Outlook.TaskItem
              Set NextTask = AddTaskItem(mt, Task.DateCompleted)
              NextTask.Save
            End If
          End If
        End If
      End If
    End If
  End If
End Sub

Private Sub Explorer_SelectionChange()
  Dim Sel As Outlook.Selection
  If Explorer.CurrentFolder.DefaultItemType = olTaskItem Then
    Set Sel = Explorer.Selection
    If Sel.Count > 0 Then
      Set Task = Sel(1)
    End If
  End If
End Sub