Excel工作簿關閉但工作表保持活動？

Question

所以，我有這個腳本，我已經運行，但修改爲基於輸入框將數據排序到不同的工作表。它可以工作，並且完成我想要的任何事情，但是現在，每次運行它時，Excel的新實例都會在後臺運行。據我所知（我對這類事情並不瞭解太多），是不知何故該工作簿正在關閉，但工作表仍處於活動狀態。我一直在尋找的東西，並閱讀了幾個小時試圖弄清楚這一點，我至少朝着正確的方向？這是一個插入PC DMIS程序（在Excel之外）的基本腳本。我有我的變化爲實現標有「工作表中輸入」排序過程（2段）：

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 Cavity As String            ‘start worksheet input 1 
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  ‘end worksheet input 1 

'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 xlApp = CreateObject("Excel.Application") 

Set xlWorkbook = xlWorkbooks.Open(TempFilename) 
Set xlSheet = xlWorkbook.Worksheets("Sheet1") 
Set xlsheets = xlworkbook.worksheets     ‘start worksheet input 2 

'Set xlWorksheets = xlapp.Worksheet 
'Set xlWorksheets = xlapp.Worksheets 
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 2 


If ResFileExists = False Then 
    RCount=6 
    CCount=3 
    xlSheet.Range("B1").Value = Part.PartName 
    xlSheet.Range("A6").Value = Date() & " " & Time() 
    xlSheet.Range("B6").Value = "Inspector Name" 
    For Each Cmd In Cmds 
     'Eliminate DATDEF's 
     If Cmd.Type <> 1299 Then 
      'Do Dimensions 
      If Cmd.IsDimension Then 
       If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then 
        Set DcmdID = Cmd.DimensionCommand 
         DimID = DcmdID.ID 
         ReportDim = Cmd.GetText (OUTPUT_TYPE, 0) 
       End If 
       If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _ 
        Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then 
        Set DCmd = Cmd.DimensionCommand 
        CheckDim = Cmd.GetText (OUTPUT_TYPE, 0) 
        If CheckDim <> "" Then 
          ReportDim = CheckDim 
        End If 
        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then 
         If DCmd.ID = "" Then 
           xlSheet.Cells(5,CCount).Value = DimID & "."& DCmd.AxisLetter 
         Else 
           xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "M" 
         End If 
           xlSheet.Cells(2,CCount).Value = DCmd.Nominal 
           xlSheet.Cells(3,CCount).Value = DCmd.Plus 
           xlSheet.Cells(4,CCount).Value = DCmd.Minus 
           'Measured Or Deviation With check For True Position 
        If DCmd.AxisLetter <> "TP" Then 
            xlSheet.Cells(6,CCount).Value = DCmd.Measured 
       Else 
            xlSheet.Cells(6,CCount).Value = DCmd.Deviation 
       End If 
           'Add Min/Max For Profile dimensions 
           If Cmd.Type = 1118 Or Cmd.Type = 1105 Then 
            CCount=CCount+1 
            xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Max" 
            xlSheet.Cells(2,CCount).Value = DCmd.Nominal 
            xlSheet.Cells(3,CCount).Value = DCmd.Plus 
            xlSheet.Cells(4,CCount).Value = DCmd.Minus 
            xlSheet.Cells(6,CCount).Value = DCmd.Max 
            CCount=CCount+1 
            xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Min" 
            xlSheet.Cells(2,CCount).Value = DCmd.Nominal 
            xlSheet.Cells(3,CCount).Value = DCmd.Plus 
            xlSheet.Cells(4,CCount).Value = DCmd.Minus 
            xlSheet.Cells(6,CCount).Value = DCmd.Min 
           End If 
           CCount=CCount+1 
        End If 
       End If 
      End If 
      'Do GDT 
      If Cmd.Type = 184 Then 
        ReportDim = Cmd.GetText (OUTPUT_TYPE, 0) 
        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then 
         xlSheet.Cells(5,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF" 
         xlSheet.Cells(2,CCount).Value = "0" 
         xlSheet.Cells(3,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1) 
         xlSheet.Cells(4,CCount).Value = "0" 
         xlSheet.Cells(6,CCount).Value = Cmd.GetText (LINE2_DEV, 1) 
         CCount=CCount+1 
        End If 
      End If 
     End If 
    Next Cmd 


Else 

'Find first Open column. 
RCount=6 
Found=0 
Do Until Found = 1 
RCount = RCount + 1 
If xlSheet.Cells(RCount,1).Value = "" Then 
Found=1 
End If 
Loop 

xlSheet.Cells(RCount,1).Value = Date() & " " & Time() 
xlSheet.Cells(RCount,2).Value= "Inspector Name" 

'Fill In measured data 
CCount = 3 
    For Each Cmd In Cmds 
     'Eliminate DATDEF's 
     If Cmd.Type <> 1299 Then 
      'Do Dimensions 
      If Cmd.IsDimension Then 
       If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then 
        Set DcmdID = Cmd.DimensionCommand 
         DimID = DcmdID.ID 
         ReportDim = Cmd.GetText (OUTPUT_TYPE, 0) 
       End If 
       If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _ 
        Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then 
        Set DCmd = Cmd.DimensionCommand 
        CheckDim = Cmd.GetText (OUTPUT_TYPE, 0) 
        If CheckDim <> "" Then 
          ReportDim = CheckDim 
        End If 
        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then 
           'Measured Or Deviation With check For True Position 
          If DCmd.AxisLetter <> "TP" Then 
            xlSheet.Cells(RCount,CCount).Value = DCmd.Measured 
       Else 
            xlSheet.Cells(RCount,CCount).Value = DCmd.Deviation 
       End If 
           'Add Min/Max For Profile dimensions 
           If Cmd.Type = 1118 Or Cmd.Type = 1105 Then 
            CCount=CCount+1 
            xlSheet.Cells(RCount,CCount).Value = DCmd.Max 
            CCount=CCount+1 
            xlSheet.Cells(RCount,CCount).Value = DCmd.Min 
           End If 
         Ccount=Ccount+1 
        End If 
       End If 
      End If 
      'Do GDT 
      If Cmd.Type = 184 Then 
        ReportDim = Cmd.GetText (OUTPUT_TYPE, 0) 
        If ReportDim = "BOTH" Or ReportDim = "REPORT" Then 
         xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF" 
         xlSheet.Cells(RCount,CCount).Value = "0" 
         xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1) 
         xlSheet.Cells(RCount,CCount).Value = "0" 
         xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_DEV, 1) 
         CCount=CCount+1 
        End If 
      End If 
     End If 
    Next Cmd 
End If 


'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

由於...

Set xlApp = CreateObject("Excel.Application") 

將創建一個Excel的新實例，你可以首先檢查是否已使用以下代碼建立Excel實例。

On Error Resume Next 
Set xlApp = GetObject("","Excel.Application") 
If Err.Number <> 0 Then 
    'No instance exists, create one 
    Set xlApp = CreateObject("Excel.Application") 
End If 
Err.Clear