使用VBA提取Microsoft Project资源使用视图的Timephase工时数据

核心逻辑说明 #

你需要的资源使用视图右侧的时间分段工时，本质是Project对象模型中的TimeScaleData接口返回的结构化数据，不需要依赖视图激活状态，直接调用接口取数的稳定性更高，适合每周自动化脚本运行。

实现步骤 #

• 绑定Project实例：可以直接调用当前打开的项目文件，也可以通过脚本直接打开SharePoint同步到本地的项目文件（需提前确认SharePoint同步状态正常，文件无独占锁）
• 遍历项目资源：跳过未分配任务、已标记为非活动的无效资源
• 调用时间分段接口：指定查询的起止时间、时间刻度（天/周）、数据类型（工时）
• 数据汇总：按周一到周五的维度累加单日工时，可按需写入自定义字段、输出到Excel或同步到SharePoint列表

可用代码示例 #

Sub CalcResourceWeeklyWork()
    Dim currentProj As Project
    Dim targetRes As Resource
    Dim tsData As TimeScaleValues
    Dim tsItem As TimeScaleValue
    Dim weekStart As Date, weekEnd As Date
    Dim weekTotalHours As Double
    
    ' 绑定当前活动项目，若需打开指定文件可替换为 FileOpen("你的本地同步路径\项目文件.mpp")
    Set currentProj = ActiveProject
    
    ' 计算当周周一到周五的日期范围，可按需修改为指定周的时间
    weekStart = Date - Weekday(Date, vbMonday) + 1
    weekEnd = weekStart + 4
    
    For Each targetRes In currentProj.Resources
        ' 过滤有效资源
        If Not targetRes Is Nothing And targetRes.Work > 0 Then
            ' 按天维度取资源分配工时
            Set tsData = targetRes.TimeScaleData( _
                StartDate:=weekStart, _
                EndDate:=weekEnd, _
                Type:=pjResourceTimescaledWork, _
                TimeScaleUnit:=pjTimescaleDays)
            
            weekTotalHours = 0
            ' 累加工作日工时，返回值默认单位为分钟，除以60转换为小时
            For Each tsItem In tsData
                If IsNumeric(tsItem.Value) Then weekTotalHours = weekTotalHours + tsItem.Value / 60
            Next tsItem
            
            ' 此处可替换为你的业务逻辑：比如写入SharePoint列表、更新项目自定义字段等
            Debug.Print "资源名：" & targetRes.Name & " 当周工时：" & weekTotalHours & "H"
        End If
    Next targetRes
End Sub

注意事项 #

• 运行前需要在VBA编辑器的「工具-引用」中勾选对应版本的Microsoft Project Object Library，避免类型未定义报错
• 操作SharePoint上的项目文件时，优先使用OneDrive同步后的本地路径访问，比直接调用HTTP路径的兼容性更高，权限错误概率更低
• 若需要统计跨项目的资源工时，需要额外开启资源池的引用逻辑

内容的提问来源于stack exchange，提问作者Jacob.b20