在任務管理器中保存Excel.exe的孤兒對象？

Question

我有這個腳本，我正在努力，而且我已經接近完成它，但有一個小問題。我在任務管理器問題中遇到了常見的Excel.exe，並且很難解決它。下面的代碼工作正常，直到我添加標記爲「工作表輸入」的行。我正在嘗試做的是將來自PC DMIS程序（Excel外部）的路線數據轉換爲基於操作員輸入框的單獨工作表。如果我刪除了我添加的行（工作表輸入），它運行良好，並且Excel會像應該那樣關閉，所以我猜測我在這些行的某處出錯了。根據我已經完成的閱讀時間，似乎我以某種方式孤立了一個對象。我在正確的軌道上，還是我需要看看別的東西？

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 

Answer 1

您的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

關於錯誤處理，我看到一個孤立的LabelEnd:。我不確定你在做什麼。

以下是一種使用錯誤處理的方法。

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