在任务pipe理器中保存Excel.exe的孤儿对象?

我正在编写这个脚本,而且已经接近完成了,但有一个小问题。 我得到常见的Excel.exe滞留在任务pipe理器的问题,并很难解决它。 下面的代码工作正常,直到我添加标记为“工作表input”的行。 我想要做的是将来自PC DMIS程序(Excel外部)的路线数据转换为基于操作员input框的单独工作表。 如果我删除了我添加的行(工作表input),它运行良好,并且Excel会像应该那样closures,所以我猜测我在这些行的某处出错了。 根据我所做的阅读时间,似乎我以某种方式孤立了一个物体。 我在正确的轨道上,还是我需要看看别的东西?

Sub Main 'xl Declarations Dim xlApp As Object Dim xlWorkbooks As Object Dim xlWorkbook As Object Dim xlSheet As Object Dim count As Integer Dim xlWorksheets As String Dim xlWorksheet As String 'pcdlrn declarations And Open ppg Dim App As Object Set App = CreateObject("PCDLRN.Application") Dim Part As Object Set Part = App.ActivePartProgram Dim Cmds As Object Set Cmds = Part.Commands Dim Cmd As Object Dim DCmd As Object Dim DcmdID As Object Dim fs As Object Dim DimID As String Dim ReportDim As String Dim CheckDim As String Dim myValue As String Dim message, title, defaultValue As String message = "Cavity" title = "cavity" defaultValue = "1" myValue = InputBox(message, title, defaultValue) If myValue = "" Then myValue = defaultValue 'Check To see If results file exists FilePath = "C:\Excel PC DMIS\3K170 B2A\" Set fs = CreateObject("Scripting.FileSystemObject") ResFileExists = fs.fileexists(FilePath & Part.partname & ".xls") 'Open Excel And Base form Set xlApp = CreateObject("Excel.Application") Set xlWorkbooks = xlapp.Workbooks If ResFileExists = False Then TempFilename = FilePath & "Loop Template.xls" Else TempFilename = FilePath & Part.partname & ".xls" End If Set xlWorkbook = xlWorkbooks.Open(TempFilename) Set xlSheet = xlWorkbook.Worksheets("Sheet1") Set xlsheets = xlworkbook.worksheets 'start worksheet input Dim sh As Worksheet, flg As Boolean For Each sh In xlworkbook.worksheets If sh.Name = myValue Then flg = True: Exit For Next If flg = False Then xlsheets.Add.Name = myValue End If Set xlSheet = xlWorkbook.Worksheets(myValue) 'end worksheet input ****** 'blah, blah, workbook formatting code here******* 'Save And Cleanup Set xlSheet = Nothing SaveName = FilePath & Part.partname & ".xls" If ResFileExists = False Then xlWorkBook.SaveAs SaveName Else xlWorkBook.Save End If xlWorkbook.Close Set xlWorkbook = Nothing xlWorkbooks.Close Set xlWorkbooks = Nothing xlApp.Quit Set xlApp = Nothing LabelEnd: End Sub 

您的Excel对象声明

 Dim xlApp As Object Dim xlWorkbooks As Object Dim xlWorkbook As Object Dim xlSheet As Object Dim sh As Worksheet 

你的清理对象

 Set xlSheet = Nothing Set xlWorkbook = Nothing Set xlWorkbooks = Nothing Set xlApp = Nothing 

你错过了

 Set sh = Nothing 

此外,由于您是晚期绑定,您可能需要将Dim sh As Worksheet更改为Dim sh As Object

关于error handling,我看到一个孤立的LabelEnd: 我不确定你在做什么。

这是一种使用error handling的方法。

 Sub Sample() On Error GoTo Whoa ' '~~> Rest of your code ' Letscontinue: '~~> Save And Cleanup Set xlSheet = Nothing Set sh = Nothing SaveName = FilePath & Part.partname & ".xls" If ResFileExists = False Then xlWorkbook.SaveAs SaveName Else xlWorkbook.Save End If xlWorkbook.Close Set xlWorkbook = Nothing xlWorkbooks.Close Set xlWorkbooks = Nothing xlApp.Quit Set xlApp = Nothing Exit Sub Whoa: MsgBox Err.Description Resume Letscontinue End Sub