1

I have this script that I'm working on, and am soooo close to having it done, but have a slight issue. I am getting the common Excel.exe lingering in the Task Manager issue, and having a hard time resolving it. The code below worked fine, until I added the lines marked "worksheet input". What I am trying to do, is route data from a PC DMIS program (outside of Excel), into separate worksheets based on the operator input box. If I take out the lines I added (worksheet input), it runs fine, and Excel closes out like it should, so I am guessing I have something wrong somewhere in those couple of lines. Based on the hours of reading I have done, it appears that I am orphaning an object somehow. Am I on the right track, or do I need to look at something else??

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
4

1 回答 1

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
于 2013-11-03T05:27:52.653 回答