Results 1 to 13 of 13
  1. #1
    Join Date
    May 2009
    Posts
    104

    Unanswered: Instance of Excel Not clearing

    I have a form with a command button that checks to see if a file exists that matches a value in a record set, If the file doesn't exist it creates it and names it based on a value in the recordset (If the file does exist it does nothing), then it checks to see if a particular sheet exists (again based on a value in a recordset), if it doesn't exist it copies "Sheet1", renames the copied sheet based on a value in a field in a recordset. The code below works but fine but it won't clear the instance of excel within access. I get an error " The remote server machine does not exist or is unavailable ". I'm missing something simple but i can't figure out what it is. I have rewritten this several times trying suggestions i found on the net by modifying the suggested code but keep getting the same result.
    Things that i have found troubleshooting this problem:
    1. The error only comes up when i run the code that copies Sheet1 and renames it. If i block out that portion of the code and just put a Msgbox "Sheet Does NOT Exist" i don't get this error and the if statement works fine and all excel instances clear up.
    2. I can run the entire SubCommand57 code without any errors if i close the database in between each button clicks, essentially i can't run the code more one time in a row.
    If you need background on what i'm trying to do here with this particular portion of my database i will be glad to elaborate, i didn't want to clutter up the post with too much info and confuse the problem.
    Any help will be greatly appreciated, maybe i will be able to sleep tonight if we can solve this problem.


    Code:
    Private Sub Command57_Click()
    On Error GoTo Error_Handle
    '
        Dim PartNum
        Dim PartDesc
        Dim TemplateSheet
        Dim WorkOrder
        Dim TemplateFile
        Dim FilePath
        Dim File
    '
        Dim xlApp As Excel.Application
        Dim xlWkbk As Excel.Workbook
        Dim xlSht As Excel.Worksheet
        Dim SheetExists As Boolean
    '
        PartNum = [Part Number]
        PartDesc = [Part Description]
        TemplateSheet = "Sheet1"
        TemplateFile = "U:\QC\FinalInspection\InspectionSheets\Template.xlsx"
        WorkOrder = [FO#]
        FilePath = "U:\QC\FinalInspection\InspectionSheets"
        File = "U:\QC\FinalInspection\InspectionSheets\" & [Part Number] & ".xlsx"
    '
        Set xlApp = New Excel.Application
    '
        If Len(Dir(File)) > 0 Then   ' Check to see if file exists
    '
        'File Does Exist
        'Do Nothing
    
    
        Else
        Set xlApp = New Excel.Application
    '
        Set xlWkbk = xlApp.Workbooks.Open(TemplateFile)
    '
        xlApp.ActiveWorkbook.SaveAs (File)
    '
        xlApp.Sheets(TemplateSheet).Select
        xlApp.Range("C2").Select
        xlApp.ActiveCell.FormulaR1C1 = PartNum
        xlApp.Range("E2:H2").Select
        xlApp.ActiveCell.FormulaR1C1 = PartDesc
    '
        xlApp.ActiveWorkbook.Save
        xlApp.ActiveWorkbook.Close
        xlApp.Workbooks.Close
        xlApp.Quit
    
            End If
    '
            Set xlWkbk = xlApp.Workbooks.Open(File)
            For Each xlSht In xlApp.ActiveWorkbook.Sheets
                If xlSht.Name = WorkOrder Then
                    SheetExists = True
                    Exit For
                End If
            Next xlSht
            If SheetExists = True Then
        'Open sheet with same name as the value in [FO#]
        'Sheet Exists
    MsgBox "Sheet Exists"
                '
            Else
        'Sheet Doesn't Exist So Create It
        'MsgBox "Sheet Does NOT Exist"
        xlWkbk.Sheets("Sheet1").Select                 'If i block out this portion all is well
        xlWkbk.Sheets("Sheet1").Copy After:=Sheets(1)  'If i block out this portion all is well
        xlWkbk.Sheets("Sheet1 (2)").Select             'If i block out this portion all is well
        xlWkbk.Sheets("Sheet1 (2)").Name = WorkOrder   'If i block out this portion all is well
    '
        End If
        xlApp.ActiveWorkbook.Save
        xlApp.ActiveWorkbook.Close
        xlApp.Workbooks.Close
        Set xlSht = Nothing
        Set xlWkbk = Nothing
        xlApp.Quit
        Set xlApp = Nothing
    '
    Exit_Command57:
    Exit Sub
    '
    Error_Handle:
        Set xlSht = Nothing
        Set xlWkbk = Nothing
        xlApp.Quit
        Set xlApp = Nothing
                MsgBox Err.Description
                    Resume Exit_Command57
            End Sub

  2. #2
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    This is a common problem. Here's a way to solve it:
    1. Place this in the Declarations section of the module:
    Code:
    Private Declare Function EndTask Lib "user32" (ByVal hWnd As Long, ByVal fShutDown As Long, ByVal fForce As Long) As Long
    2. In the function where you instanciate Excel:
    Code:
        Dim xlhwnd As Long
       Set xlapp = New Excel.Application
        
       With xlapp 
            xlhwnd = xlapp.hWnd
    ' 
    ' Do your things with Excel.
    '
    
        ' Save the file (if necessary).
        '
            .ActiveWorkbook.Save
        
        ' Then close it.
        '
            .Workbooks.Close
        
        ' Close Excel. !!! This is very important !!!
        ' If you do not property close the instance of Excel it will remain
        ' locked in memory with no visible interface (only the Task Manager to kill it).
        '
            .Quit
            
        ' Force Excel out of the memory (sometimes necessary).
        '
            EndTask xlhwnd, 0, 1
            
        End With
        
        ' Clean up
        '
        Set xlapp = Nothing
    Have a nice day!

  3. #3
    Join Date
    May 2009
    Posts
    104
    I meant to mention even if i kill it in task manager it still errors out. So now with you suggested code added i still get the same error. I have task manager open and i see the EXCEL.EXE*32 process clear but i still keep getting the same error. Is there a hidden instance of excel i can't see? It still only works if I close Access and reopen. Am I going about this all wrong?
    Last edited by dbshaft; 09-08-11 at 17:59.

  4. #4
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    Quote Originally Posted by dbshaft View Post
    I meant to mention even if i kill it in task manager it still errors out. So now with you suggested code added i still get the same error
    This seems logical as the API function EndTask is the one used by the Task Manager itself.

    Now if you carefully examine your code, you'll see that you create several instances of Excel without properly closing one before re-using the variable XLApp to create another one. There should be one and only one instance of Excel created in the whole procedure.
    Have a nice day!

  5. #5
    Join Date
    May 2009
    Posts
    104
    I cleaned up the code a little but as far as i can see there is only one instance of Excel. Unless the problem stems from opening the template file, then "saving as" but never actually closing it. Any suggestions? Sorry for all the hand holding!
    Code:
    Private Sub Command57_Click()
    'On Error GoTo Error_Handle
    '
        Dim PartNum
        Dim PartDesc
        Dim TemplateSheet
        Dim WorkOrder
        Dim TemplateFile
        Dim FilePath
        Dim File
    '
        Dim xlApp As Excel.Application
        Dim xlWkbk As Excel.Workbook
        Dim xlSht As Excel.Worksheet
        Dim SheetExists As Boolean
    
    '
        PartNum = [Part Number]
        PartDesc = [Part Description]
        TemplateSheet = "Sheet1"
        TemplateFile = "U:\QC\FinalInspection\InspectionSheets\Template.xlsx"
        WorkOrder = [FO#]
        FilePath = "U:\QC\FinalInspection\InspectionSheets"
        File = "U:\QC\FinalInspection\InspectionSheets\" & [Part Number] & ".xlsx"
        
    '
        Set xlApp = New Excel.Application
    '
        If Len(Dir(File)) > 0 Then   ' Check to see if file exists
    '
        'File Does Exist
        'Do Nothing
    
    
        Else
        xlApp.Workbooks.Open (TemplateFile)
    '
        xlApp.ActiveWorkbook.SaveAs (File)
    '
        xlApp.Sheets(TemplateSheet).Select
        xlApp.Range("C2").Select
        xlApp.ActiveCell.FormulaR1C1 = PartNum
        xlApp.Range("E2:H2").Select
        xlApp.ActiveCell.FormulaR1C1 = PartDesc
    '
        xlApp.ActiveWorkbook.Save
        xlApp.ActiveWorkbook.Close
        xlApp.Workbooks.Close
        xlApp.Quit
    
            End If
    '
            xlApp.Workbooks.Open (File)
            For Each xlSht In xlApp.ActiveWorkbook.Sheets
                If xlSht.Name = WorkOrder Then
                    SheetExists = True
                    Exit For
                End If
            Next xlSht
            If SheetExists = True Then
        'Open sheet with same name as the value in [FO#]
        'Sheet Exists
    MsgBox "Sheet Exists"
                '
            Else
    
        'Sheet Doesn't Exist So Create It
    
        xlApp.Sheets("Sheet1").Select
        xlApp.Sheets("Sheet1").Copy After:=Sheets(1)
        xlApp.Sheets("Sheet1 (2)").Select
        xlApp.Sheets("Sheet1 (2)").Name = WorkOrder
    '
        End If
    '
        xlApp.ActiveWorkbook.Save
        xlApp.ActiveWorkbook.Close
        Set xlSht = Nothing
        Set xlWkbk = Nothing
        xlApp.Quit
        Set xlApp = Nothing
    
    '
    Exit_Command57:
    Exit Sub
    '
    Error_Handle:
        Set xlSht = Nothing
        Set xlWkbk = Nothing
        xlApp.Quit
        Set xlApp = Nothing
                MsgBox Err.Description
                    Resume Exit_Command57
            End Sub

  6. #6
    Join Date
    May 2009
    Posts
    104

    Revamp

    I redid my code so i don't have any chance of more than one instance of Excel at any time. Now the code works perfect except the EXCEL.EXE still doesn't clear, any suggestions on what to do now? Moreover if i end the process with task manager everything still works. The end task function you suggested earlier may do the trick here but the way you had it written i'm not sure how to integrate it into my code. If i wasn't anal and wanted everything to be perfect i would just leave it as is. Here is what i have up to this point.

    Code:
    Private Sub Command57_Click()
    On Error GoTo Error_Handle
    '
        Dim PartNum
        Dim PartDesc
        Dim TemplateSheet
        Dim WorkOrder
        Dim TemplateFile
        Dim FilePath
        Dim File
    '
        Dim SheetExists As Boolean
        Dim fso As New FileSystemObject
    '
        PartNum = [Part Number]
        PartDesc = [Part Description]
        TemplateSheet = "Sheet1"
        TemplateFile = "U:\QC\FinalInspection\InspectionSheets\Template.xlsx"
        WorkOrder = [FO#]
        FilePath = "U:\QC\FinalInspection\InspectionSheets"
        File = "U:\QC\FinalInspection\InspectionSheets\" & [Part Number] & ".xlsx"
    '
        If Len(Dir(File)) > 0 Then   ' Check to see if file exists
    '
        'File Does Exist
        'Do Nothing
        Else
    '
        fso.CopyFile TemplateFile, File
            End If
    '
            Workbooks.Open (File)
            For Each xlSht In ActiveWorkbook.Sheets
                If xlSht.Name = WorkOrder Then
                    SheetExists = True
                    Exit For
                End If
            Next xlSht
            If SheetExists = True Then
        'Open sheet with same name as the value in [FO#]
        'Sheet Exists
    MsgBox "Sheet Exists"
                '
            Else
    
        'Sheet Doesn't Exist So Create It
        Sheets("Sheet1").Select
        Range("C2").Select
        ActiveCell.FormulaR1C1 = PartNum
        Range("E2:H2").Select
        ActiveCell.FormulaR1C1 = PartDesc
        Sheets("Sheet1").Select
        Sheets("Sheet1").Copy After:=Sheets(1)
        Sheets("Sheet1 (2)").Select
        Sheets("Sheet1 (2)").Name = WorkOrder
    '
        End If
    '
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        Workbooks.Close
    '
    Exit_Command57:
    Exit Sub
    '
    Error_Handle:
        Workbooks.Close
                MsgBox Err.Description
                    Resume Exit_Command57
            End Sub

  7. #7
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    Don't fear to use the API function EndTask to get rid of Excel. Just insert its declaration on top of the module (after the Option Compare Database and Option Explicit directives) and use it as indicated in the code I posted to free the memory (nothing wrong will happen if Excel is already unloaded).
    Have a nice day!

  8. #8
    Join Date
    May 2009
    Posts
    104
    If you will notice i took all of the references to
    Code:
       Dim xlApp As Excel.Application
        Dim xlWkbk As Excel.Workbook
        Dim xlSht As Excel.Worksheet
    out of the code, this was the only way to get this to work. I'm not sure how to use the EndTask API function if i don't have the references. I have tried a couple of different things only to make things worse.

  9. #9
    Join Date
    May 2009
    Posts
    104
    I found this post in another forum
    Excel automation fails second time code runs
    which describes this problem exactly. It makes sense but i'm not sure where the reference is missing nor do i know what it would look like. When I get back to the office Monday I'll do a little trial and error and see if I can figure it out. If anyone has any suggestions please feel free to chime in.

  10. #10
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    Now that makes sense! Here is the culprit:
    Code:
    xlApp.Sheets("Sheet1").Copy After:=Sheets(1)
    The reference to xlApp is missing. It should be:
    Code:
    xlApp.Sheets("Sheet1").Copy After:=.Sheets(1)
    There could be similar errors elsewhere in the code.
    Have a nice day!

  11. #11
    Join Date
    May 2009
    Posts
    104
    That is the place in the code where the debugger kept stopping but I could never figure out why. I'll give it a shot when I get back into the office. Never thought a simple decimal point would give me so much trouble.

  12. #12
    Join Date
    May 2009
    Posts
    104

    Finally

    That did the trick. I have posted the finished code if anyone would like it for reference. Thank you Sinndho for all the help. Now i can get some sleep tonight.
    This was the line of code giving all the fuss.
    Code:
            xlApp.Sheets("Sheet1").Copy After:=xlApp.Sheets(1)
    Here is the working code:
    Code:
    Private Sub Command57_Click()
    On Error GoTo Error_Handle
    '
        Dim PartNum
        Dim PartDesc
        Dim TemplateSheet
        Dim WorkOrder
        Dim TemplateFile
        Dim FilePath
        Dim File
    '
        Dim xlApp As Excel.Application
        Dim xlWkbk As Excel.Workbook
        Dim xlSht As Excel.Worksheet
        Dim SheetExists As Boolean
        Dim fso As New FileSystemObject
    '
        PartNum = [Part Number]
        PartDesc = [Part Description]
        TemplateSheet = "Sheet1"
        TemplateFile = "U:\QC\FinalInspection\InspectionSheets\Template.xlsx"
        WorkOrder = [FO#]
        FilePath = "U:\QC\FinalInspection\InspectionSheets"
        File = "U:\QC\FinalInspection\InspectionSheets\" & [Part Number] & ".xlsx"
    '
        Set xlApp = New Excel.Application
    '
        If Len(Dir(File)) > 0 Then   ' Check to see if file exists
    '
        'File Does Exist
        'Do Nothing
        Else
    '
        fso.CopyFile TemplateFile, File
            End If
    '
            xlApp.Workbooks.Open (File)
            For Each xlSht In xlApp.ActiveWorkbook.Sheets
                If xlSht.Name = WorkOrder Then
                    SheetExists = True
                    Exit For
                End If
            Next xlSht
            If SheetExists = True Then
        'Open sheet with same name as the value in [FO#]
        'Sheet Exists
    'MsgBox "Sheet Exists"
            xlApp.Sheets(WorkOrder).Select
            Else
    '
        'Sheet Doesn't Exist So Create It
            xlApp.Sheets("Sheet1").Select
            xlApp.Range("C2").Select
            xlApp.ActiveCell.FormulaR1C1 = PartNum
            xlApp.Range("E2:H2").Select
            xlApp.ActiveCell.FormulaR1C1 = PartDesc
            xlApp.Sheets("Sheet1").Select
            xlApp.Sheets("Sheet1").Copy After:=xlApp.Sheets(1)
            xlApp.Sheets("Sheet1 (2)").Select
            xlApp.Sheets("Sheet1 (2)").Name = WorkOrder
    '
        End If
    '
        xlApp.ActiveWorkbook.Save
        xlApp.ActiveWorkbook.Close
        xlApp.Workbooks.Close
        Set xlSht = Nothing
        Set xlWkbk = Nothing
        xlApp.Quit
        Set xlApp = Nothing
    '
    Exit_Command57:
        ShellExec "U:\QC\FinalInspection\InspectionSheets\" & [Part Number] & ".xlsx"
    Exit Sub
    '
    Error_Handle:
                MsgBox Err.Description
                    Resume Exit_Command57
            End Sub

  13. #13
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    You're welcome... and sleep well!
    Have a nice day!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •