Orphaned объект хранения Excel.exe в диспетчере задач?

Question

У меня есть этот сценарий, над которым я работаю, и я так близок к его завершению, но имею небольшую проблему. Я получаю общий файл Excel.exe в задаче диспетчера задач и с трудом решая его. Приведенный ниже код работал нормально, пока я не добавил строки с пометкой «ввод рабочего листа». То, что я пытаюсь сделать, - это данные маршрута из программы 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