This code sample creates three new tasks based on one task, with the start and due dates of the each task in the series 2 - 5 days after the previous task and the code sample on page 2 creates tasks from a selected appointment, with each task due in the days leading up to the appointment. The code can be tweaked to create a series or tasks or appointments from an email message or other Outlook items.
If you need to create a large number of tasks or skip weekends and holidays, it will be easier to create the tasks (or appointments) in Excel and Import them into Outlook or use a utility from the Tools section below. Sample workbook
The subject in my example includes the date date of the task because it makes it easier to see that it is working. Once you are satisfied with the code, you can change the subject field as necessary.
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.
If you need to include the body of the original task, add the following line to each task section. Don't forget to change the task#.
objTask1.Body = .Body
Create a series of tasks based on one task
Public Sub CreateNewTasksFromCurrentTasks() Dim obj As Object Dim Sel As Outlook.Selection Dim objTask1 As Outlook.TaskItem Dim objTask2 As Outlook.TaskItem Dim objTask3 As Outlook.TaskItem Dim objTask4 As Outlook.TaskItem Dim objFolder As Outlook.MAPIFolder Set Sel = Application.ActiveExplorer.Selection If Sel.Count Then Set obj = Sel(1) Set objFolder = obj.Parent If TypeOf obj Is Outlook.TaskItem Then Set objTask1 = obj Set objTask2 = objFolder.Items.Add(olTaskItem) Set objTask3 = objFolder.Items.Add(olTaskItem) Set objTask4 = objFolder.Items.Add(olTaskItem) 'Create task #2 With objTask1 objTask2.Categories = .Categories objTask2.Companies = .Companies objTask2.ContactNames = .ContactNames objTask2.StartDate = objTask1.StartDate + 2 objTask2.DueDate = objTask2.StartDate + 5 objTask2.Subject = objTask2.DueDate & " " & .Subject End With 'Create task #3 With objTask1 objTask3.Categories = .Categories objTask3.Companies = .Companies objTask3.ContactNames = .ContactNames objTask3.StartDate = objTask2.StartDate + 4 objTask3.DueDate = objTask3.StartDate + 5 objTask3.Subject = objTask3.DueDate & " " & .Subject End With 'Create task #4 With objTask1 objTask4.Categories = .Categories objTask4.Companies = .Companies objTask4.ContactNames = .ContactNames objTask4.StartDate = objTask3.StartDate + 2 objTask4.DueDate = objTask4.StartDate + 5 objTask4.Subject = objTask4.DueDate & " " & .Subject End With On Error Resume Next objTask2.Save ' objTask2.Display objTask3.Save ' objTask3.Display objTask4.Save ' objTask4.Display End If Set objTask1 = Nothing Set objTask2 = Nothing Set objTask3 = Nothing Set objTask4 = Nothing Set obj = Nothing End If End Sub
|Tools in the Spotlight|
Capture YOUR standard work flows by creating templates of entire series of appointments and tasks. Click a button to use the templates to accurately calculate and schedule all your appointments and tasks for a project. See the full picture by viewing all appointments and tasks for a project in one place. Finally when a deadline changes, Easily and Accurately reschedule ALL affected appointments and tasks. This is your complete Outlook based scheduling and project management tool.