Automatisch Folgeaufgaben erstellen

Dieses Beispiel erzeugt automatisch eine neue Aufgabe, sobald Sie die vorhergehende Aufgabe als erledigt markieren. Fügen Sie den ersten Teil in das Modul 'DieseOutlookSitzung' ein.

  So fügen Sie Makros in Outlook ein

Private m_TaskList As MyTaskList

Public Sub AddFirstTaskItem()
  m_TaskList.AddFirstTaskItem
End Sub

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

Klicken Sie nun auf Einfügen -> Klassenmodul. Drücken Sie dann f4 und tragen Sie als Namen 'MyTask' ein. In das Modul fügen Sie den folgenden Code ein.

Public Subject As String

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

Fügen Sie ein weiteres Klassenmodul mit folgendem Code hinzu und nennen Sie das Modul 'MyTaskList'.

In der ersten Prozedur (CreateTaskList) können Sie Ihre Liste mit Aufgaben erstellen. Jede Zeile steht für eine Aufgabe. Die erste Aufgabe steht oben, die zweite darunter und so weiter. Wenn die erste Aufgabe später als erledigt markiert wird, wird die Aufgabe der zweiten Zeile erstellt und so weiter. In diesem einfachen Beispiel brauchen Sie pro Aufgabe nur drei Werte anzugeben:

1. Betreff
2. BeginDateOffset: Tragen Sie hier ein, wieviele Tage später die Aufgabe beginnen soll.
3. DueDateOffset: Tragen Sie hier ein, wieviele Tage später die Aufgabe fällig sein soll.

Beispiel: Die erste Aufgabe beginnt an dem Tag, an dem Sie die Aufgabe erstellen (offset 0) und ist zwei Tage später fällig (offset 2). Die zweite Aufgabe beginnt an dem Tag, an dem Sie die erste als erledigt markieren (offset 0) und ist noch am gleichen Tag fällig (offset 0). Die dritte Aufgabe beginnt sieben Tage, nachdem die zweite als erledigt markiert wurde und ist einen Tag später fällig.

Benutzen Sie zum Erstellen der ersten Aufgabe die Funktion 'AddFirstTaskItem', die Sie z.B. über alt+f8 aufrufen können. Damit wird sichergestellt, dass die Aufgabe mit allen nötigen Informationen erstellt wird, damit der Folgemechanismus funktioniert. Diese Aufgabe wird angezeigt, so dass Sie noch Änderungen vornehmen können. Alle Folgeaufgaben werden nicht angezeigt, sondern direkt gespeichert.

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("aufgabe 1", 0, 2)
  List.Add Array("aufgabe 2", 0, 0)
  List.Add Array("aufgabe 2 nachverfolgen", 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