如何将工作时间从 MS Project 导出到 MS Excel？

问题描述

我有一个项目文件，其中包含在具有工作时间/天的不同工作站上配置的产品。我设法通过 VBA/宏导出了假期/例外，但我需要工作时间。每个工作站的上午 6:30 至下午 14:30。在项目文件中，我可以通过单击 Project > Change Working Time 查看此信息 - 此时我可以从下拉列表 For calendar 中选择工作站，并且有一个迷你日历，我可以在其中选择特定日期 - 通过单击date 我可以看到当天的工作时间。我也可以通过点击 Details 按钮查看此信息。

是否有任何内置函数可用于提取该数据？或者是否可以通过宏获取该信息？我需要将这些数据提取到 Excel 文件中，以便稍后将其导入 sql 数据库。

我用来提取假期/例外的代码如下（我从谷歌搜索中复制粘贴，它不是我写的，我是 MS Project/VBA 的新手）：

Option Explicit
Sub CalendarWeekdays()

Dim MyXL As Object
Set MyXL = CreateObject("Excel.Application")
Dim i As Integer,j As Integer
Dim E As Exception
Dim R As Resource
Dim xlRng

'open Excel,define workbook,and set column headers
MyXL.Workbooks.Add
MyXL.Visible = True
MyXL.ActiveWorkbook.worksheets.Add.Name = "Exception Report"
MyXL.ActiveWorkbook.worksheets("Exception Report").Activate
Set xlRng = MyXL.activesheet.Range("A1")
xlRng.Range("A1") = "Proj Cal Holidays"
xlRng.Range("B1") = "Start Date"
xlRng.Range("C1") = "Finish Date"
xlRng.Range("E1") = "Res Name"
xlRng.Range("F1") = "Res Base Cal"
xlRng.Range("G1") = "Base Cal Excep"
xlRng.Range("H1") = "Start Date"
xlRng.Range("I1") = "Finish Date"
xlRng.Range("K1") = "Resource Name"
xlRng.Range("L1") = "Res Excep"
xlRng.Range("M1") = "Start Date"
xlRng.Range("N1") = "Finish Date"

'First gather and export Project calendar exceptions
i = 2
If ActiveProject.Calendar.Exceptions.Count > 0 Then
    For Each E In ActiveProject.Calendar.Exceptions
        xlRng.Range("A" & i) = E.Name
        xlRng.Range("B" & i) = E.Start
        xlRng.Range("C" & i) = E.Finish
        i = i + 1
    Next
End If

'Next,gather and export resource base calendar exceptions along with
'   resource calendar exceptions
i = 2
For Each R In ActiveProject.Resources
    If Not R Is nothing Then
        j = i
        If R.Type = pjResourceTypeWork Then
                For Each E In R.Calendar.BaseCalendar.Exceptions
                    xlRng.Range("E" & i) = R.Name
                    xlRng.Range("F" & i) = R.Calendar.BaseCalendar.Name
                    xlRng.Range("G" & i) = E.Name
                    xlRng.Range("H" & i) = E.Start
                    xlRng.Range("I" & i) = E.Finish
                    i = i + 1
                Next E
                For Each E In R.Calendar.Exceptions
                    xlRng.Range("K" & j) = R.Name
                    xlRng.Range("L" & j) = E.Name
                    xlRng.Range("M" & j) = E.Start
                    xlRng.Range("N" & j) = E.Finish
                    j = j + 1
                Next E
        End If
    End If
Next R
MyXL.ActiveWorkbook.worksheets("Exception Report").Columns("A:N").AutoFit
End Sub

更新：

我设法从 Exceptions 和 Weekdays 中获取了时间！这是我完整的工作 VBA 代码：

Option Explicit
Sub CalendarWeekdays()

Dim MyXL As Object
Set MyXL = CreateObject("Excel.Application")
Dim i As Integer
Dim R As Resource
Dim d As PjWeekday
Dim E As Exception
Dim xlRng
MyXL.Workbooks.Add
MyXL.Visible = True

' I. EXCEPTIONS

' a. Export resource base calendar exceptions along with
'    resource calendar exceptions
MyXL.ActiveWorkbook.Worksheets("Sheet1").Activate
MyXL.activesheet.Name = "Base & Resource Exceptions"
Set xlRng = MyXL.activesheet.Range("A1")
MyXL.activesheet.Range("A1:K1").Font.Bold = True

xlRng.Range("A1") = "Resource"
xlRng.Range("B1") = "Resource Base Name"
xlRng.Range("C1") = "Name"
xlRng.Range("D1") = "Start"
xlRng.Range("E1") = "Finish"
xlRng.Range("F1") = "S1 Start"
xlRng.Range("G1") = "S1 Finish"
xlRng.Range("H1") = "S2 Start"
xlRng.Range("I1") = "S2 Finish"
xlRng.Range("J1") = "S3 Start"
xlRng.Range("K1") = "S3 Finish"

i = 2
For Each R In ActiveProject.Resources
    If Not R Is nothing Then
        If R.Type = pjResourceTypeWork Then
                For Each E In R.Calendar.Exceptions
                    xlRng.Range("A" & i) = R.Name
                    xlRng.Range("B" & i) = R.Calendar.BaseCalendar.Name
                    xlRng.Range("C" & i) = E.Name
                    xlRng.Range("D" & i) = E.Start
                    xlRng.Range("E" & i) = E.Finish
                    xlRng.Range("F" & i) = E.Shift1.Start
                    xlRng.Range("G" & i) = E.Shift1.Finish
                    xlRng.Range("H" & i) = E.Shift2.Start
                    xlRng.Range("I" & i) = E.Shift2.Finish
                    xlRng.Range("J" & i) = E.Shift3.Start
                    xlRng.Range("K" & i) = E.Shift3.Finish
                    i = i + 1
                Next E
        End If
    End If
Next R

' b. Export project calendar exceptions
MyXL.ActiveWorkbook.Worksheets.Add.Name = "Project Exceptions"
MyXL.ActiveWorkbook.Worksheets("Project Exceptions").Activate
Set xlRng = MyXL.activesheet.Range("A1")
MyXL.activesheet.Range("A1:I1").Font.Bold = True

xlRng.Range("A1") = "Name"
xlRng.Range("B1") = "Start"
xlRng.Range("C1") = "Finish"
xlRng.Range("D1") = "S1 Start"
xlRng.Range("E1") = "S1 Finish"
xlRng.Range("F1") = "S2 Start"
xlRng.Range("G1") = "S2 Finish"
xlRng.Range("H1") = "S3 Start"
xlRng.Range("I1") = "S3 Finish"

i = 2
If ActiveProject.Calendar.Exceptions.Count > 0 Then
    For Each E In ActiveProject.Calendar.Exceptions
        xlRng.Range("A" & i) = E.Name
        xlRng.Range("B" & i) = E.Start
        xlRng.Range("C" & i) = E.Finish
        xlRng.Range("D" & i) = E.Shift1.Start
        xlRng.Range("E" & i) = E.Shift1.Finish
        xlRng.Range("F" & i) = E.Shift2.Start
        xlRng.Range("G" & i) = E.Shift2.Finish
        xlRng.Range("H" & i) = E.Shift3.Start
        xlRng.Range("I" & i) = E.Shift3.Finish
        i = i + 1
    Next
End If

' II. WEEKDAYS
MyXL.ActiveWorkbook.Worksheets.Add.Name = "Weekdays"
MyXL.ActiveWorkbook.Worksheets("Weekdays").Activate
Set xlRng = MyXL.activesheet.Range("A1")
MyXL.activesheet.Range("A1:H1").Font.Bold = True

xlRng.Range("A1") = "Resource"
xlRng.Range("B1") = "Weekdays"
xlRng.Range("C1") = "S1 Start"
xlRng.Range("D1") = "S1 Finish"
xlRng.Range("E1") = "S2 Start"
xlRng.Range("F1") = "S2 Finish"
xlRng.Range("G1") = "S3 Start"
xlRng.Range("H1") = "S3 Finish"

i = 2
For Each R In ActiveProject.Resources
    If Not R Is nothing Then
        For d = pjSunday To pjSaturday
            xlRng.Range("A" & i) = R.Name
            xlRng.Range("B" & i) = WeekdayName(d)
            xlRng.Range("C" & i) = R.Calendar.WeekDays(d).Shift1.Start
            xlRng.Range("D" & i) = R.Calendar.WeekDays(d).Shift1.Finish
            xlRng.Range("E" & i) = R.Calendar.WeekDays(d).Shift2.Start
            xlRng.Range("F" & i) = R.Calendar.WeekDays(d).Shift2.Finish
            xlRng.Range("G" & i) = R.Calendar.WeekDays(d).Shift3.Start
            xlRng.Range("H" & i) = R.Calendar.WeekDays(d).Shift3.Finish
            i = i + 1
        Next d
    End If
Next R

End Sub

解决方法

使用 WeekDays 对象获取每个日历的班次。这是一个循环每个工作日并输出前 3 个班次开始和结束时间的示例。 （注意：更新 Range 引用以适合您所需的格式！）

Dim d As PjWeekday
For d = pjSunday To pjSaturday
    xlRng.Range("tbd",rownum) = R.Calendar.WeekDays(d).Shift1.Start
    xlRng.Range("tbd",rownum) = R.Calendar.WeekDays(d).Shift1.Finish
    xlRng.Range("tbd",rownum) = R.Calendar.WeekDays(d).Shift2.Start
    xlRng.Range("tbd",rownum) = R.Calendar.WeekDays(d).Shift2.Finish
    xlRng.Range("tbd",rownum) = R.Calendar.WeekDays(d).Shift3.Start
    xlRng.Range("tbd",rownum) = R.Calendar.WeekDays(d).Shift3.Finish
Next d