Create a Series of Tasks using VBA

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

Next page >> Create a series of tasks leading up to an appointment

Related Posts:

1. 

   Create a Task from an Email using a Rule
2. 

   Create Outlook appointments using multiple recurring patterns
3. 

   Send an email when an Appointment reminder fires
4. 

   Open a webpage when a Task reminder fires

Pages: 1 2