如何为MS Project生成的Outlook会议邀请添加多个参会者

原代码仅获取任务的第一个资源并添加为参会者，要实现给所有分配资源发送会议邀请，需要循环遍历任务的所有资源，逐个添加为Outlook会议的必填参会者。

修改后的完整代码 #

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
    Dim myPResEmail As String
    Dim res As Resource ' 新增资源对象变量，用于遍历所有资源

    On Error Resume Next
    Set myOLApp = CreateObject("Outlook.Application")

    For Each myTask In ActiveSelection.Tasks
        Set myItem = myOLApp.CreateItem(olAppointmentItem)
        With myItem
            .MeetingStatus = olMeeting
            .Start = myTask.Start
            .End = myTask.Finish
            .Subject = myTask.Name & " (MS Project Task)"
            .Location = myTask.Text3
            .Categories = myTask.UniqueID
            .Body = myTask.Notes
            .BusyStatus = olFree

            ' 循环遍历任务的所有分配资源，逐个添加为必填参会者
            For Each res In myTask.Resources
                myPResEmail = res.EMailAddress
                ' 跳过空邮箱的资源，避免无效参会者
                If myPResEmail <> "" Then
                    Set myRequiredAttendee = .Recipients.Add(myPResEmail)
                    myRequiredAttendee.Type = olRequired
                End If
            Next res

            .ReminderSet = True
            .ReminderOverrideDefault = True
            .ReminderMinutesBeforeStart = myTask.Number1
                
            .Categories = myTask.Guid

            .Send
        End With
    Next myTask

End Sub

关键修改说明 #

• 新增res As Resource变量，用来遍历任务下的所有资源
• 替换原单一资源获取逻辑，用For Each res In myTask.Resources循环处理每个资源
• 添加空邮箱判断If myPResEmail <> "" Then，避免添加无效的参会者条目
• 保留原代码的其他功能（会议时间、主题、提醒等设置）

内容的提问来源于stack exchange，提问作者Rick Hiddink