The code sample on this page creates tasks from a selected appointment, with each task due in the days leading up to the appointment.
We also have a code sample that creates additional tasks from a selected tasks, with the start and due dates of the each task in the series 2 - 5 days after the previous task. The code can be tweaked to create a series of tasks or appointments from an email message or other Outlook items.
To use, select the master task (or appointment) and run the macro. To make it easier to use, assign a toolbar or QAT button to the macro.
This sample code uses the subject and date of the selected appointment to create tasks prior to the date. For example, a realtor needs to check on specific things at specific times prior to a home closing. The pattern is always the same but it does not fit within a recurrence pattern and each task is different, so they aren't true recurrences.
Updated December 7 2014 to handle a large number of tasks more efficiently.
To create more than five tasks, change the value in the i = 1 to 4 line and add additional Cases.
Public Sub CreateNewTaskFromSelectedAppointment()
Dim obj As Object
Dim Sel As Outlook.Selection
Dim objAppt As Outlook.AppointmentItem
Dim objTask As Outlook.TaskItem
Dim objFolder As Outlook.MAPIFolder
Dim i As Long
Set Sel = Application.ActiveExplorer.Selection
If Sel.Count Then
Set obj = Sel(1)
If TypeOf obj Is Outlook.AppointmentItem Then
Set objAppt = obj
For i = 1 To 4
Set objTask = Application.CreateItem(olTaskItem)
Select Case i
Case 1
objTask.StartDate = objAppt.Start - 20
objTask.DueDate = objTask.StartDate + 1
objTask.Subject = "20 days before: (" & objTask.DueDate & ") " & objAppt.Subject
Case 2
objTask.StartDate = objAppt.Start - 15
objTask.DueDate = objTask.StartDate + 1
objTask.Subject = "15 days before: (" & objTask.DueDate & ") " & objAppt.Subject
Case 3
objTask.StartDate = objAppt.Start - 10
objTask.DueDate = objTask.StartDate + 1
objTask.Subject = "10 days before: (" & objTask.DueDate & ") " & objAppt.Subject
Case 4
objTask.StartDate = objAppt.Start - 5
objTask.DueDate = objTask.StartDate + 1
objTask.Subject = "5 days before: (" & objTask.DueDate & ") " & objAppt.Subject
End Select
' Fields that will not vary between the tasks go here
With objTask
.Categories = objAppt.Categories
.Body = objAppt.Body
.Save
' .Display
End With
Next i
End If
Quit:
Set objTask = Nothing
Set obj = Nothing
End If
End Sub
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
More Information
Create a Series of Tasks using VBA
The base for these code samples came from Journal: Create a new item based on an existing one.
Hello, I am new to coding, but creating a series of tasks from an appointment is exactly what I'm looking to do. I followed the instructions for macro settings and adding buttons and did a couple small test codes that I was able to run successfully, but when I copied and pasted this then tried to run it on an appointment, nothing happened...I didn't make any changes, since I figured once I did a successful test run I could tinker with it. Do I need to remove spaces or something to make it work? Sorry to trouble you with such a basic question, but I appreciate your help, and would be so grateful if I can get this to work!
Where did you copy and paste it to? First guess would be macro security - but this would only apply if you copied it to a new computer.
Diane:
Thank you for the many examples of code, I would like to use your examples of creating tasks from an event on the calendar, I would like those tasks to be created on a shared Calendar, can you help me combine those two macros?
Create a Series of Tasks Leading up to an Appointment and this.
Dim NS As Outlook.NameSpace
Dim objOwner As Outlook.Recipient
Set NS = Application.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("maryc")
objOwner.Resolve
If objOwner.Resolved Then
'MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If
thanks
if its a shared exchange calendar in your mailbox, put the dim lines at the top of the macro, the Set's and rest of resolve lines after the last dim. You need to change this line to the mailbox alias or name
Set objOwner = NS.CreateRecipient("maryc")
As written, it works in the default task folder. You can either move the task after you create it or set the task folder and use Add.
before the i = 1 to 4 line add this
Set objFolder = = NS.GetSharedDefaultFolder(objOwner, olFolderTasks)
replace the line that creates the last with this
Set objTask = objFolder.Items.Add(olTaskItem)