vbaoutlookcalendarms-project

Add multiple attendees to an Outlook meeting invite created in MS Project


I put a task I created in MS Project as a meeting in the Outlook calendar of the assigned resource.

The task is put in the calendar of the first person only, when I have assigned multiple resources to the task.

How do I add multiple resources to the Outlook meeting invitation?

Option Explicit

Public myOLApp As Outlook.Application

Sub Export_Selection_To_OL_Appointments()
    Dim myTask As Task
    Dim myItem As Outlook.AppointmentItem
    Dim myRequiredAttendee As Outlook.Recipient 'Vas as Set Outlook Recipient
    Dim myPResEmail As String 'Var as email Address-String

    On Error Resume Next  'if error found, jump to next
    'Starts Microsoft Outlook (if it's not already running) and opens the default Inbox folder
    Set myOLApp = CreateObject("Outlook.Application")

    For Each myTask In ActiveSelection.Tasks 'Loop through the tasks
        Set myItem = myOLApp.CreateItem(olAppointmentItem) 'Create an appointment
        With myItem                    'For each appointment do something
            .MeetingStatus = olMeeting     'Set the meeting status to meeting
            .Start = myTask.Start          'Set the start and finish
            .End = myTask.Finish
            .Subject = myTask.Name & " (MS Project Task)"
            .Location = myTask.Text3
            .Categories = myTask.UniqueID
            .Body = myTask.Notes
            .BusyStatus = olFree

            'Add a required attendee
            myPResEmail = myTask.Resources(1).EMailAddress   'Resources(1).EMailAddress
            Set myRequiredAttendee = .Recipients.Add(myPResEmail)
            myRequiredAttendee.Type = olRequired

            'Set a reminder
            .ReminderSet = True
            .ReminderOverrideDefault = True
            .ReminderMinutesBeforeStart = myTask.Number1
                
            'Make this appointment unique for later reference
            .Categories = myTask.Guid
            '.Class = myTask.Guid

            '.Save
            'Send this meeting invite
            .Send

        End With
    Next myTask

End Sub

Solution

  • To add all assigned resources to the meeting invite, loop through the task's assignments:

    'Add required attendees
    Dim asn As Assignment
    For Each asn in myTask.Assignments
        Set myRequiredAttendee = .Recipients.Add(asn.Resource.EMailAddress)
        myRequiredAttendee.Type = olRequired
    Next asn