ms-project

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


I am quite new to VBA, but thanks to you and google I managed to put a task I created in MS Project as a meeting in the Outlook calendar of the assigned resource.

The only problem is that the task is only put in the calendar of 1 person (only the first), even if I have assigned multiple resources to a task.

Can someone help me to add multiple resources to the Outlook meeting invitation? Below is the script I have been using so far.

Thanks in advance for your help!

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

Thanks


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