Email zur Nachverfolgung kennzeichnen

Ab Outlook 2007

Kennzeichnen Sie auch Ihre E-Mails zur Nachverfolgung nach festen Regeln? Z.B. weniger dringendes oder privates für heute abend; nachsehen, ob der Kunde schon geantwortet hat, nächste Woche etc. Dieses VBA-Beispiel nimmt Ihnen dabei viele Mausklicks ab; gerade das Auswählen des Datums und der Uhrzeit erforderte ja sonst viel Zeit.

Die folgende Funktion ist das Kernstück. Dieser übergeben Sie, wieviele Tage im voraus die Aufgabe fällig sein soll (0 für heute, 1 für morgen etc.) und optional können Sie eine Uhrzeit und den Betreff für die Aufgabe festlegen. Aufrufbeispiele folgen darunter.

Den kompletten Code können Sie entweder in das schon vorhandene Modul 'DieseOutlookSitzung' kopieren, oder Sie fügen ein neues 'Modul' hinzu und fügen dort den Code ein.

  So fügen Sie Makros in Outlook ein

Public Sub MarkItemAsTask(ByVal AddDays As Long, _
  Optional TimeOfDay As String = "08:00", _
  Optional Subject As String, _
  Optional Mail As Outlook.MailItem _
)
  Dim Items As VBA.Collection
  Dim obj As Object
  Dim i As Long
  Dim dt As Date
  Dim tm As String
  Dim Icon As OlMarkInterval
  
  dt = DateAdd("d", AddDays, Date)
  tm = CStr(dt) & " " & TimeOfDay
  
  If AddDays < 1 Then
    Icon = olMarkToday
  ElseIf AddDays = 1 Then
    Icon = olMarkTomorrow
  ElseIf Weekday(Date, vbUseSystemDayOfWeek) + AddDays < 8 Then
    Icon = olMarkThisWeek
  Else
    Icon = olMarkNextWeek
  End If
  
  If Mail Is Nothing Then
    Set Items = GetCurrentItems
  Else
    Set Items = New VBA.Collection
    Items.Add Mail
  End If
  
  For Each obj In Items
    If TypeOf obj Is Outlook.MailItem Then
      Set Mail = obj
      Mail.MarkAsTask Icon
      Mail.TaskStartDate = tm
      Mail.TaskDueDate = tm
      If Len(Subject) Then
        Mail.TaskSubject = Subject
        Mail.FlagRequest = Subject
      End If
      Mail.ReminderTime = tm
      Mail.ReminderSet = true
      Mail.Save
    End If
  Next
End Sub

Private Function GetCurrentItems() As VBA.Collection
  Dim c As VBA.Collection
  Dim Sel As Outlook.Selection
  Dim obj As Object
  Dim i&
  
  Set c = New VBA.Collection
  
  If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    c.Add Application.ActiveInspector.CurrentItem
  Else
    Set Sel = Application.ActiveExplorer.Selection
    If Not Sel Is Nothing Then
      For i = 1 To Sel.Count
        c.Add Sel(i)
      Next
    End If
  End If
  Set GetCurrentItems = c
End Function

Und hier folgen zwei Aufrufbeispiele für die Funktion. Das erste erstellt Aufgaben für morgen und als Betreff wird der Betreff der Email übernommen. Das zweite erstellt Aufgaben für übermorgen, 11 Uhr, mit dem Betreff 'Antwort senden'. Sie können die Funktionen nach Belieben umbenennen, z.B. 'FälligMorgen' statt 'Beispiel_1'.

Wenn ein Ordner das aktive Fenster ist und sie rufen die Funktion auf, dann werden alle ausgewählten Emails markiert. Ist dagegen eine geöffnete Email das aktive Fenster, dann wird nur die eine markiert.

Eine weitere Möglichkeit wäre, die zu markierende Email aus einem anderen Makro zu übergeben. Zum Beispiel könnten Sie das Erstellen einer Aufgabe durch Zuweisen einer Kategorie auslösen. Siehe auch Aktionen mit Kategorien auslösen.

Public Sub Beispiel_1()
  'Fällig: morgen, 8 Uhr
  MarkItemAsTask 1
End Sub

Public Sub Beispiel_2()
  'Fällig: übermorgen, 11 Uhr
  MarkItemAsTask 2, "11:00", "Antwort senden"
End Sub

Bis Outlook 2003

Vor Outlook 2007 gab es die Todo-Bar noch nicht. Dieses alte Beispiel für Outlook 2003 ist anders aufgebaut als das obige, erfüllt aber den gleichen Zweck.

Public Enum FlagWhatEnum
  flNextWeek = 0
  flThisEvening = 1
  flTomorrow = 2
End Enum

Public Sub FlagNextWeek()
  FlagItem flNextWeek
End Sub

Public Sub FlagThisEvening()
  FlagItem flThisEvening
End Sub

Public Sub FlagTomorrow()
  FlagItem flTomorrow
End Sub

Private Sub FlagItem(FlagWhat As FlagWhatEnum)
  Dim Mail As Outlook.MailItem
  Dim obj As Object
  Dim Sel As Outlook.Selection
  Dim i&
  Dim dt As Date
  Dim tm As String
  Dim Icon As OlFlagIcon

  Select Case FlagWhat
  Case flNextWeek
    dt = DateAdd("d", 7, Date)
    tm = CStr(dt) & " 08:00"
    Icon = olOrangeFlagIcon
  Case flThisEvening
    dt = Date
    tm = CStr(dt) & " 19:00"
    Icon = olYellowFlagIcon
  Case flTomorrow
    dt = DateAdd("d", 1, Date)
    tm = CStr(dt) & " 08:00"
    Icon = olYellowFlagIcon
  End Select

  Set obj = Application.ActiveWindow
  If TypeOf obj Is Outlook.Explorer Then
    Set Sel = obj.Selection
    For i = 1 To Sel.Count
      Set obj = Sel(i)
      If TypeOf obj Is Outlook.MailItem Then
        Set Mail = obj
        Mail.FlagDueBy = tm
        Mail.FlagIcon = Icon
        Mail.Save
      End If
    Next
  Else
    Set obj = obj.CurrentItem
    If TypeOf obj Is Outlook.MailItem Then
      Set Mail = obj
      Mail.FlagDueBy = tm
      Mail.FlagIcon = Icon
      Mail.Save
    End If
  End If
End Sub