Mail2Task in Outlook

Da in meiner Firma mit Outlook gearbeitet wird, habe ich auch meine Aufgaben in Outlook organisiert.
Nun habe ich bisher immer das Feature „Eine Aufgabe aus dieser Mail erstellen” vermisst.
Folgendes VBA-Makro habe ich nun dafür erstellt:

Option Explicit
Public Sub Mail2Task()
Dim olTask As Outlook.TaskItem
Dim olMail As MailItem
Dim olIns As Inspector
Dim olExp As Explorer
Set olTask = Application.CreateItem(olTaskItem)
Set olExp = Application.ActiveExplorer
If olExp.Selection.Count <> 1 Then
MsgBox "Funktioniert nur mit genau einer E-Mail"
Exit Sub
End If
If Not TypeOf olExp.Selection.Item(1) Is Outlook.MailItem Then
MsgBox "Funktioniert nur mit E-Mails !"
Exit Sub
End If
Set olMail = olExp.Selection.Item(1)
With olTask
.Subject = olMail.Subject
.Body = olMail.Subject & vbCrLf & vbCrLf
.StartDate = Now
.DueDate = DateAdd("d", 7, Date)
.ReminderSet = False
.Status = olTaskInProgress
End With
olTask.Attachments.Add olMail
Set olIns = olTask.GetInspector
olIns.Display ("True")
End Sub
view raw Mail2Task.vba hosted with ❤ by GitHub

Das Makro erstellt aus einer selektierten eMail eine folgende Aufgabe:

  • Betreff der Aufgabe entspricht dem Betreff der eMail
  • Text der Aufgabe enthält noch einmal den Betreff der eMail sowie die eigentliche Mail als Anhang.
  • Start der Aufgabe ist sofort
  • Termin (Ende) ist in 7 Tagen
  • Status ist „In Progress”

Anschließend wird die Aufgabe zur Bearbeitung (Termin-anpassung, Wichtigkeit, etc.) geöffnet.