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

Question

我遇到了一个自动化的问题，我似乎无法解决。

目前，我有一个工作表，("Project")在 "A"(Project Name)& "B"(Project File Location)列中包含了数据，"B "列包含了每个MS Project文件的字符串位置。

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

前2个项目都没有任何问题，但是在第3个项目上，我收到了运行时错误'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

使用 选择任务字段 方法假定文件保存在任务视图中，并且你想要的列在视图的表中。最好直接从下面的 任务 对象。

看来您正在寻找第一个任务的% 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").