在 Excel VBA 中引用 MSProject 会产生运行时错误 91 对象变量或未设置块变量
Referencing MSProject in Excel VBA produces Runtime Error 91 object variable or with block variable not set
我的 objective 是遍历许多 MS Project 文档,其中文件路径(例如 L:\Project\Scchedule.mpp)存储在工作表 "Projects" 的 C 列(从单元格 C2 开始)。
这一行 returns 运行时错误 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
当你打电话给
PrjApp.Application.FileOpenEx PrjFullName
PrjApp 为 Nothing,这是导致错误的原因。在此调用之前,添加一行
设置 PrjApp = 新 MSProject.Application
原来问题是我在循环命令之前以某种方式关闭了项目应用程序。需要在循环命令后移动它。具体来说,这些行:
PrjApp.FileClose False
PrjApp.Quit pjDoNotSave
Set PrjApp = Nothing
感谢大家的时间和建议!
我的 objective 是遍历许多 MS Project 文档,其中文件路径(例如 L:\Project\Scchedule.mpp)存储在工作表 "Projects" 的 C 列(从单元格 C2 开始)。
这一行 returns 运行时错误 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
当你打电话给
PrjApp.Application.FileOpenEx PrjFullName
PrjApp 为 Nothing,这是导致错误的原因。在此调用之前,添加一行
设置 PrjApp = 新 MSProject.Application
原来问题是我在循环命令之前以某种方式关闭了项目应用程序。需要在循环命令后移动它。具体来说,这些行:
PrjApp.FileClose False
PrjApp.Quit pjDoNotSave
Set PrjApp = Nothing
感谢大家的时间和建议!