VBA 错误 1101:值无效

Question

此代码打开一堆MS Project 2016文档，并将内容转储到Excel 2016工作表中。MS 项目文件路径在范围 (rng2( C2：C 和最后一行。每次通过时，都会在到达范围内的第六项时引发 1101 错误。Fail at PrjApp.FileOpenEx rng2.

• 无论文件路径在范围。
• 当文件路径在 1 中测试 1 时，代码将运行完成时间，所以我知道路径和文件很好。
• 手表显示 rng2 值正是失败时应有的值(例如，该值设置为所需的文件路径(。

这对我来说毫无意义，但代码一定有问题。有什么想法吗？

Sub OpenProjectCopyPasteData()
Dim PrjApp      As MSProject.Application
Dim aProg       As MSProject.Project
Dim PrjFullName As String
Dim t           As Task
Dim rngClr     As Range
Dim rngClr2     As Range
Dim rng         As Range
Dim rng2        As Range
Dim ws1         As Worksheet
Dim ws2         As Worksheet
Dim MyCell      As Variant
Dim Lastrow     As Long

Set ws1 = Worksheets("MS Project Milestones")
Set ws2 = Worksheets("Active NRE Projects")
Set rngClr = ws1.Range("A:G")
Set PrjApp = New MSProject.Application
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ws1.Activate
'Clear current contents of Project Data tab
rngClr.ClearContents
'Open MS Project file
ws2.Activate
Set rng2 = Sheets("Active NRE Projects").Range("C2")
Do Until IsEmpty(rng2.Value)
PrjApp.FileOpenEx rng2
Set aProg = PrjApp.ActiveProject
' show all tasks
OutlineShowAllTasks
ws1.Activate
'Copy the project columns and paste into Excel
SelectTaskColumn Column:="Name"
EditCopy
Set ws1 = Worksheets("MS Project Milestones")
Set rng = ws1.Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats
SelectTaskColumn Column:="Resource Names"
EditCopy
Set rng = ws1.Range("B" & Cells(Rows.Count, "B").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats
SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws1.Range("F" & Cells(Rows.Count, "F").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats
SelectTaskColumn Column:="Text1"
EditCopy
Set rng = ws1.Range("C" & Cells(Rows.Count, "C").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats
SelectTaskColumn Column:="Text2"
EditCopy
Set rng = ws1.Range("D" & Cells(Rows.Count, "D").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats
With Sheets("MS Project Milestones")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        Lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        Lastrow = 1
    End If
End With
With Sheets("MS Project Milestones")
        .Range("A" & (Lastrow + 1)).Value = "X"
        .Range("B" & (Lastrow + 1)).Value = "X"
        .Range("C" & (Lastrow + 1)).Value = "X"
        .Range("D" & (Lastrow + 1)).Value = "X"
        .Range("F" & (Lastrow + 1)).Value = "X"
End With
PrjApp.FileClose False
'PrjApp.Quit pjDoNotSave
'Set PrjApp = Nothing
ws2.Activate
Set rng2 = rng2.Offset(1, 0)
Loop
' reset settings of Excel and MS-Project
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'PrjApp.FileClose False
PrjApp.Quit pjDoNotSave
Set PrjApp = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

最好始终指定正在使用的应用程序对象。

因此，更改对 OutlineShowAllTasks、SelectTaskColumn 和 EditCopy 方法的非限定引用，以便它们显式引用您的 PrjApp 应用程序对象，例如

PrjApp.OutlineShowAllTasks
'...
PrjApp.SelectTaskColumn Column:="Name"
PrjApp.EditCopy
'... etc

---

即使它没有避免内存和引用问题，显式指定应用程序也可以使其他人更容易理解您的代码 - 通过包含PrjApp.，他们可以轻松看到诸如 OutlineShowAllTasks 之类的东西是 MSProject 方法，并且他们不会花时间查看您的 Excel 代码以查找Sub OutlineShowAllTasks()(这是我第一次看到您的代码时所做的(。