需求：编写Excel启动VBA宏从MS Project同步文档状态

一、前期准备 #

• 确认电脑已安装Microsoft Project，且Excel能调用Project对象库
• 记好你的MS Project文件完整路径（比如C:\Documents\DocTracking.mpp）
• Excel里提前设好对应列：比如A列存Doc ID、B列存Doc Status（可根据实际列调整）

二、添加宏的操作步骤 #

1. 打开目标Excel文件，按Alt + F11打开VBA编辑器
2. 在左侧工程资源管理器里找到你的工作簿，双击ThisWorkbook（要实现打开自动运行，代码必须写在这里）
3. 粘贴下面的代码，替换代码里的Project文件路径、工作表名和列位置

Private Sub Workbook_Open()
    ' 定义变量
    Dim projApp As Object
    Dim projTask As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim docID As String
    Dim docStatus As String
    Dim matchFound As Boolean
    
    ' 替换成你的MS Project文件完整路径
    Const ProjectFilePath As String = "C:\你的路径\文档跟踪.mpp"
    
    ' 指定要更新的Excel工作表（比如Sheet1，按实际表名修改）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 启动或调用已打开的Project程序
    On Error Resume Next
    Set projApp = GetObject(, "MSProject.Application")
    If Err.Number <> 0 Then
        Set projApp = CreateObject("MSProject.Application")
        projApp.Visible = False ' 后台运行，不弹出Project窗口
    End If
    On Error GoTo 0
    
    ' 打开指定的Project文件
    On Error Resume Next
    projApp.FileOpen ProjectFilePath
    If Err.Number <> 0 Then
        MsgBox "找不到指定的Project文件，请检查路径是否正确！", vbExclamation
        projApp.Quit
        Set projApp = Nothing
        Exit Sub
    End If
    On Error GoTo 0
    
    ' 获取Excel中数据的最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Project里的所有任务
    For Each projTask In projApp.ActiveProject.Tasks
        If Not projTask Is Nothing Then
            ' 读取Project自定义字段的值（名称必须和Project里的完全一致）
            docID = projTask.GetField(projApp.FieldNameToFieldConstant("Doc ID"))
            docStatus = projTask.GetField(projApp.FieldNameToFieldConstant("Doc Status"))
            
            ' 只有Doc ID不为空时才处理
            If docID <> "" Then
                matchFound = False
                ' 在Excel里查找匹配的Doc ID
                For i = 2 To lastRow ' 假设第1行是表头，从第2行开始遍历
                    If ws.Cells(i, "A").Value = docID Then
                        ' 同步最新状态
                        ws.Cells(i, "B").Value = docStatus
                        matchFound = True
                        Exit For
                    End If
                Next i
                
                ' 如果Excel里没有这个Doc ID，就新增一行
                If Not matchFound Then
                    ws.Cells(lastRow + 1, "A").Value = docID
                    ws.Cells(lastRow + 1, "B").Value = docStatus
                    lastRow = lastRow + 1
                End If
            End If
        End If
    Next projTask
    
    ' 关闭Project文件（若需要保存Project的修改，把False改成True）
    projApp.FileClose Save:=False
    ' 退出Project程序
    projApp.Quit
    
    ' 释放占用的资源
    Set projTask = Nothing
    Set projApp = Nothing
    Set ws = Nothing
    
    MsgBox "文档状态同步完成！", vbInformation
End Sub

三、关键注意事项 #

• Project里的自定义字段名称必须和代码里的完全一致，包括大小写和空格
• 如果你的Excel列不是A（Doc ID）、B（Doc Status），要修改代码里的ws.Cells(i, "A")和ws.Cells(i, "B")为对应列（比如改成"C"或数字3）
• 首次运行可能会触发宏安全提示，需要启用宏：文件>选项>信任中心>信任中心设置>宏设置>启用所有宏（或选择“启用签署的宏”，后续可给宏签名）
• 如果Project文件被其他人打开，可在projApp.FileOpen里添加参数ReadOnly:=True，以只读模式打开同步

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