VBA错误1101:值无效

此代码打开一堆MS Project 2016文档,并将内容转储到Excel 2016表单中。 MS Project文件path在范围(rng2)C2:C&Last Row中。 每次通过时,1101错误都会在达到范围中的第六项时抛出。 在PrjApp.FileOpenEx rng2失败。

  • 无论文件path如何在范围内sorting,都会发生错误。
  • 当文件path一次被testing1时代码运行完成,所以我知道path和文件是好的。
  • 手表显示rng2值正是在故障发生时的情况(例如,将值设置为所需的文件path)。

这对我来说没有意义,但是代码一定有问题。 有任何想法吗?

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 

始终指定您正在使用的应用程序对象是一个好习惯。

因此,将您的非限定引用修改为OutlineShowAllTasksSelectTaskColumnEditCopy方法,以便它们显式引用您的PrjApp应用程序对象,例如

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

即使它没有避免内存和引用问题,明确地指定应用程序也会让别人更容易理解你的代码 – 通过包含PrjApp. 他们可以很容易地看到诸如OutlineShowAllTasks类的东西是MSProject方法,并且他们没有花时间浏览你的Excel代码寻找一个Sub OutlineShowAllTasks() (这是我第一次看到你的代码时所做的)。