使用 Excel VBA 从多个 MS 项目文件中检索数据

Question

我遇到了一个我似乎无法弄清楚的自动化问题。

目前，我有一个工作表（“项目”），其中包含“A”（项目名称）和“B”（项目文件位置）列中的数据。 “B”列包含每个 MS Project 文件的字符串位置。

我的 VBA 宏循环遍历“B”列并打开每个 MS Project 文件并使用 .SelectTaskField 方法复制一个任务，然后将其复制回工作表的“E”列。

前 2 个项目循环运行没有任何问题，但是，在第三个项目中，我收到运行时错误“1004”：方法发生意外错误。 我和我的同事翻遍了代码和 MS 项目文件，看看数据是否有任何差异，我们找不到任何差异。

下面是我一直在使用的代码的副本。 只是想看看其他人是否有类似的问题。我发现 MS Project 不喜欢像 Excel 或 Word 那样被操作。

任何帮助将不胜感激。

Sub Test()
Dim ws As Worksheet
Set ws = Worksheets("Projects")
Dim lrow As Long
lrow = Range("B" & Rows.Count).End(xlUp).Row
'Turns off updates and alerts
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Select Daily Field Reports and clear worksheet
ws.Range("E2:E" & lrow).ClearContents
'Opens MS Project
Set objproject = CreateObject("MSProject.Project")
'This keeps MS Project invisible. If you want to see it, change to "True"
objproject.Application.Visible = True
        Dim oproject As Range
        'This cycles through the range and gathers the data for each project
        For Each oproject In Range("B2:B" & lrow)
        Set objproject = CreateObject("MSProject.Project")
            oproject.Select
            objproject.Application.FileOpen Selection
            objproject.Application.Visible = True
            objproject.Application.SelectTaskField Row:=1, Column:="Percent Complete", RowRelative:=False  'The column name must match. This is the only issue that I have uncovered.
            objproject.Application.EditCopy
            ws.Select
            Dim lastrow As Long
            lastrow = ws.Cells(Rows.Count, "E").End(xlUp).Row + 1
            Dim Rng As Range
            Set Rng = ws.Range("E" & lastrow)
            'Rng.PasteSpecial xlPasteFormats
            Rng.PasteSpecial xlPasteValues
            objproject.Application.Quit
        Next oproject
'Turns updates and alerts back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Closes MS Project
objproject.Application.Quit

End Sub

Answer 1

使用SelectTaskField 方法假定文件保存在任务视图中，并且您想要的列在视图的表中。最好直接从Task 对象中获取您需要的值。

您似乎正在寻找第一个任务的 % Complete 值。在这种情况下使用这个：

objproject.ActiveProject.Tasks(1).PercentComplete

这是它在您的代码中的工作方式。我冒昧地简化了一点：

Sub Test()
    Dim ws As Worksheet
    Set ws = Worksheets("Projects")
    Dim lrow As Long
    lrow = Range("B" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    ws.Range("E2:E" & lrow).ClearContents
    Dim objproject As MSProject.Application
    Set objproject = CreateObject("MSProject.Application")
    objproject.Application.Visible = True
    Dim oproject As Range
    For Each oproject In Range("B2:B" & lrow)
        objproject.FileOpen Name:=oproject.Value, ReadOnly:=True
        oproject.Offset(, 3) = objproject.ActiveProject.Tasks(1).PercentComplete
        objproject.FileCloseEx
    Next oproject
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    objproject.Quit
End Sub

请注意，获取应用程序对象的引用而不是该对象的子对象更直接：CreateObject("MSProject.Application") 优于 CreateObject("MSProject.Project")。