在Excel中引用MSProject VBA生成运行时错误91对象变量或未设置块变量

Question

我的目标是遍历许多MS Project文档，其中文件路径（例如L：\ Project \ Scchedule.mpp）存储在C列的工作表“Projects”中（从单元格C2开始）。

该行返回运行时错误91（对象变量或未设置块变量）。 PrjApp.Application.FileOpenEx PrjFullName

Sub OpenProjectCopyPasteData()

Dim PrjApp      As MSProject.Application
Dim aProg       As MSProject.Project
Dim PrjRange    As Range
Dim PrjFullName As String
Dim t           As Task
Dim rng         As Range
Dim rng1        As Range
Dim rng2        As Range
Dim rng3        As Range
Dim ws1         As Worksheet
Dim ws2         As Worksheet
Dim MyCell      As Range

Set ws1 = Worksheets("Project Data")
Set rng1 = ws1.Range("A:D")
Set rng2 = ws1.Range("F:F")
Set ws2 = Worksheets("Projects")
Set PrjRange = ws2.Range("C2")
Set PrjRange = Range(PrjRange, PrjRange.End(xlDown))


'Clear current contents of Project Data tab
rng1.ClearContents
rng2.ClearContents

For Each MyCell In PrjRange

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Open MS Project file
PrjFullName = MyCell
If PrjFullName = "" Then GoTo 99

PrjApp.Application.FileOpenEx PrjFullName
Set aProg = PrjApp.ActiveProject

' show all tasks
OutlineShowAllTasks

'Copy the project columns and paste into Excel
SelectTaskColumn Column:="Name"
EditCopy
Set ws1 = Worksheets("Project Data")
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

' reset settings of Excel and MS-Project
Application.DisplayAlerts = True
Application.ScreenUpdating = True
PrjApp.ScreenUpdating = True
PrjApp.DisplayAlerts = True

'PrjApp.FileClose False
PrjApp.Quit pjDoNotSave
Set PrjApp = Nothing

Next MyCell

99 Sheets("Projects").Activate

End Sub

Answer 1

你打电话的时候

PrjApp.Application.FileOpenEx PrjFullName

PrjApp是Nothing，导致错误。在此呼叫之前，添加一行

设置PrjApp = new MSProject.Application

Answer 2

事实证明问题是我在循环命令之前以某种方式关闭了项目应用程序。需要在循环命令后移动它。具体来说，这些行：

 PrjApp.FileClose False
 PrjApp.Quit pjDoNotSave
 Set PrjApp = Nothing

感谢大家的时间和建议！