Outlook: Move Email to secondary Tasks Calendar

In Microsoft Outlook, I like to use a secondary Calendar for planning my Tasks. This has the advantage not to block my main calendar by default (else you have to be careful to mark the appointment as Free) and have a clear split between Meetings and personal Tasks management.

I present here my way to "put" an email into my Tasks calendar in one click without duplicating content and with a real link from the Calendar entry to the original email.  

1. Background
2. How to setup
3. Usage
4. References
5. Main code

Background

It is possible to move an email to your calendar if you Flag the email and then drag the tasks to the calendar : it will copy the plain description and have no direct link to the original email.

See for example here.

Also, you could drag and drop the email to your calendar: this will generate a cloned copy in your calendar.

A third way is to use a Quick step to create an appointment and attaching the email to it.

What I am missing in all these approaches is a real link from my Calendar entry to the original Email at the source - and I also want to avoid duplicating content.

I personally really like to have a direct link to the email, because after having done the task I most likely want to reply to the email to inform about the task completion - keeping the thread unbroken.

Moreover, I like to plan such tasks to my secondary Tasks calendar and don't want to be careful to which Calendar I schedule it.

How to setup

You can get the code in my outlook-vba GitHub repository.

You shall get the Utils module including the GetCurrentItem function, Sleep function and CopyAttachments and the Email module including the CopyToTasksCalendar Sub.

Alternatively you can get the full standalone VBA code including all the requires Sub/Functions in this gist.

The CopyToTasksCalendar Sub shall be used in your QAT or ribbon custom button.

See How to add a macro to a button: https://www.youtube.com/watch?v=IzutmC6o2zg from SlipStick

Usage

The default scenario will flag the email and keep it and create a link to the email in the calendar entry. (pretty really cool.)

You could change this behavior in the macro options at the top of the Sub e.g. you can change it to delete the converted email and also be asked to copy or not the attachments.

References

https://blogs.windows.com/windowsexperience/2018/12/16/windows-10-tip-schedule-items-by-dragging-a-task-to-your-calendar/

https://www.slipstick.com/developer/code-samples/create-outlook-appointment-from-message/

Main code

Main macro/ code is extracted in this Gist: 

	' https://tdalon.blogspot.com/2020/10/outlook-email-to-tasks-calendar.html
	Public Sub CopyToTasksCalendar()
	' Calls GetCurrentItem
	Dim objAppt As Outlook.AppointmentItem
	Dim Item As Object ' works with any outlook item
	' OPTIONS
	Dim bAskAttach As Boolean
	bAskAttach = False ' Change to True if you want to be asked to attach. Preferred: False and keep link
	Dim bAskDelete As Boolean
	bAskDelete = False ' Change to True if you want to be asked if you want to delete original Item. Preferred: False alsways keep and use a link
	Set Item = GetCurrentItem()
	Set CalFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Folders("Tasks")
	Set objAppt = CalFolder.Items.Add(olAppointmentItem)
	With objAppt
	.Subject = Item.Subject
	'.Body = Item.Body
	.Start = Now
	'.End = Now
	'.ReminderSet = False
	'.BusyStatus = olFree ' Not needed in separate Tasks calendar
	End With
	If (bAskAttach) And (Item.Attachments.Count > 0) Then
	If MsgBox("Do you want to copy attachments from original item to the Task?", vbYesNo + vbQuestion + vbDefaultButton1) = vbYes Then
	Call CopyAttachments(Item, objAppt)
	End If
	End If
	If bAskDelete Then
	If MsgBox("Do you want to delete original item?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
	objAppt.Body = Item.Body
	Item.Delete
	End If
	Else
	' Flag email
	If TypeOf Item Is Outlook.MailItem Then
	Item.MarkAsTask olMarkNoDate
	Item.FlagRequest = "Follow up in Calendar"
	Item.Save
	End If
	' Add Link to Email
	' Create dummy email
	Dim olMail As Outlook.MailItem
	Set olMail = Outlook.CreateItem(olMailItem)
	olMail.Body = Item.Body
	sLink = "outlook:" & Item.EntryID
	sText = Item.Subject & " (" + Item.SenderName & ")"
	sHtml = "<a href=" & sLink & ">" & sText & "</a>"
	olMail.HTMLBody = sHtml & "<br>" & Item.HTMLBody
	olMail.Display 'Required else change is not copied
	Sleep (500)
	' Copy Body with Formatting : requires copy to Email then paste into Appointment
	Set objInsp = olMail.GetInspector
	If objInsp.EditorType = olEditorWord Then
	Set objDoc = objInsp.WordEditor
	Set objWord = objDoc.Application
	Set objSel = objWord.Selection
	With objSel
	.WholeStory
	.Copy
	End With
	End If
	' Paste to Appointment with formatting
	'objAppt.Subject = objAppt.Subject & vbCrLf & sLink
	objAppt.Display 'show to add notes ' required at the beginning - else error at paste. objSel broken
	Sleep (500)
	Set objInsp = objAppt.GetInspector
	Set objDoc = objInsp.WordEditor
	Set objSel = objDoc.Windows(1).Selection
	objSel.PasteAndFormat (wdFormatOriginalFormatting)
	olMail.Close (olDiscard)
	End If
	End Sub

view raw CopyToTasksCalendar.bas hosted with ❤ by GitHub

A tricky part in the macro is to copy the Email HTML body to the appointment item: you can not directly write/copy the body of an appointment in HTML format (but you can for an email). The trick I use is to use a temporary Email item and copy/ paste the body of this email to the appointment using the WordEditor object. 

The macro will also flag the original email as "Follow-up in Calendar".

The Destination Calendar is hard-coded at the beginning of the macro and is named "Tasks"

Set CalFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Folders("Tasks")