如何修改MS Project宏，仅向新增分配资源发送Outlook邮件？

要实现仅通知自上次宏运行以来新分配的资源，核心是追踪已发送过通知的资源分配，避免重复发送。下面提供两种可行方案，优先推荐自定义字段方案（数据持久化更可靠）：

方案一：使用自定义字段追踪已通知的分配 #

步骤1：创建自定义分配字段 #

1. 打开MS Project，点击顶部菜单栏的资源选项卡
2. 选择分配信息，在弹出窗口中点击自定义字段
3. 选择分配类型，新建一个「是/否」类型的自定义字段，命名为已通知

修改后的宏代码 #

Sub SendNewAssignmentEmails()
    Dim oProject As Project
    Dim oTask As Task
    Dim oAssign As Assignment
    Dim oMail As Object
    Dim oOutlook As Object
    
    ' 初始化Outlook对象（避免重复创建）
    Set oOutlook = CreateObject("Outlook.Application")
    Set oProject = ActiveProject

    ' 遍历所有任务
    For Each oTask In oProject.Tasks
        If Not oTask Is Nothing And oTask.Assignments.Count > 0 Then
            ' 遍历任务的所有资源分配
            For Each oAssign In oTask.Assignments
                ' 检查该分配是否未发送过通知
                If oAssign.GetField(FieldNameToFieldConstant("已通知", pjAssignment)) = False Then
                    ' 获取资源邮箱
                    Dim resourceEmail As String
                    resourceEmail = oAssign.Resource.EMailAddress
                    
                    If resourceEmail <> "" Then
                        ' 创建邮件
                        Set oMail = oOutlook.CreateItem(0)
                        With oMail
                            .To = resourceEmail
                            .Subject = "新任务分配通知"
                            .Body = "你已被分配至任务：" & oTask.Name & vbCrLf & _
                                    "任务工期：" & oTask.Duration & vbCrLf & _
                                    "开始时间：" & oTask.Start
                            .Send ' 替换为.Display可以预览邮件
                        End With
                        
                        ' 标记该分配为已通知
                        oAssign.SetField FieldNameToFieldConstant("已通知", pjAssignment), True
                    End If
                End If
            Next oAssign
        End If
    Next oTask
    
    ' 保存项目，确保自定义字段的修改被保留
    oProject.Save
    
    ' 释放对象
    Set oMail = Nothing
    Set oOutlook = Nothing
    Set oAssign = Nothing
    Set oTask = Nothing
    Set oProject = Nothing
End Sub

方案二：基于上次运行时间筛选新分配（适合临时场景） #

如果不想添加自定义字段，可以记录宏上次运行的时间，对比资源分配的创建时间。但注意：如果项目关闭后重启，上次运行时间会丢失，需手动维护。

修改后的宏代码 #

Sub SendNewAssignmentEmailsByTime()
    Dim oProject As Project
    Dim oTask As Task
    Dim oAssign As Assignment
    Dim oMail As Object
    Dim oOutlook As Object
    Dim lastRunTime As Date
    
    ' 手动设置上次宏运行的时间，需每次运行后更新
    lastRunTime = #2024/05/20 09:00:00#
    
    Set oOutlook = CreateObject("Outlook.Application")
    Set oProject = ActiveProject

    For Each oTask In oProject.Tasks
        If Not oTask Is Nothing And oTask.Assignments.Count > 0 Then
            For Each oAssign In oTask.Assignments
                ' 检查分配创建时间是否晚于上次运行时间
                If oAssign.Created > lastRunTime Then
                    Dim resourceEmail As String
                    resourceEmail = oAssign.Resource.EMailAddress
                    
                    If resourceEmail <> "" Then
                        Set oMail = oOutlook.CreateItem(0)
                        With oMail
                            .To = resourceEmail
                            .Subject = "新任务分配通知"
                            .Body = "你已被分配至任务：" & oTask.Name
                            .Send
                        End With
                    End If
                End If
            Next oAssign
        End If
    Next oTask
    
    ' 释放对象
    Set oMail = Nothing
    Set oOutlook = Nothing
    Set oAssign = Nothing
    Set oTask = Nothing
    Set oProject = Nothing
End Sub

关键说明 #

• 方案一的自定义字段会永久保存在项目文件中，即使关闭项目也不会丢失追踪记录，是更稳定的方案
• 确保资源的EMailAddress字段已正确填写，否则邮件无法发送
• 测试时建议将.Send替换为.Display，预览无误后再改为自动发送

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