在任务管理器中保留Excel.exe的孤立对象?

时间:2013-11-02 19:02:10

标签: excel excel-vba vba

我有这个脚本,我正在努力,而且我已经完成了它,但是有一个小问题。我得到常见的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

1 个答案:

答案 0 :(得分:0)

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