Closing the Excel Object after Automation from Access

Hi,

I am creating an Excel report from Access and performing formatting on this Excel Workbook. When I get to the end of the procedure I close all objects and set them to Nothing...

...however...

when I use the Range Object, used to create pivots tables etc, The Excel.exe process still remains open when viewing the task manager process list.

Below I have two sets of code. The first works fine, no Range object is set. In the second block of code however, I set the range object and it will then not close the Excell.exe process.

If you copy the folowing into a module it should all compile and you will see that cmdExport works while cmdExport2 leaves an Excel.exe process running...

Thanks in advance
Matt

'*******************************************MODULE START
Option Compare Database
Option Explicit

Private Sub cmdExport()
'*******************************************************************************
'   What:           -   Creates the Asset RE-Classification Excel Report
'   Author:         -   Matthew Mottram - London Productivity Initiative
'   Created:        -   29/04/2002 9:57:26 AM
'   Version:        -   1.00
'*******************************************************************************
On Error GoTo cmdExport_Error
   
    Dim strFilename As String
    Dim strTempFilename As String
   
    Dim xlApp As Excel.Application
    Dim xlBook As Workbook
    Dim rng As Excel.Range
   
    DoCmd.Hourglass True
    DoCmd.SetWarnings False
   
    strFilename = "C:\zzISPN2.xls" ' szFileSaveDlg("Excel Files", "*.xls", "Enter Report Name", False)
    strTempFilename = "C:\zzISPN.xls"
   
    'Exit if the user did not select a filename
    If strFilename = "None" Then err.Raise (3000)
   
    'Export the report
    If blnFileExists(strTempFilename) Then blnDeleteDosFile (strTempFilename)
    If blnFileExists(strFilename) Then
        If MsgBox("This file already exists.@@Do you wish to replace it?", vbQuestion + vbYesNo, "CONFIRM FILE REPLACE") = VBYES Then
            blnDeleteDosFile (strFilename)
        Else
            Exit Sub
        End If
    End If
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "stbl_Globals", strTempFilename, True
   
    'Format the report
    Set xlApp = New Excel.Application
    Set xlBook = xlApp.Workbooks.Open(strTempFilename)
   
    With xlBook
       
        'Insert header rows
        .Sheets(1).Rows("1:4").Insert Shift:=xlDown
       
        'Insert title
        .Sheets(1).Range("A1").FormulaR1C1 = "ASSET RE-CLASSIFICATION"
        .Sheets(1).Range("A1").Select
        'With Selection.Font
            .Sheets(1).Range("A1").Font.Name = "Book Antiqua"
            .Sheets(1).Range("A1").Font.Size = 18
            .Sheets(1).Range("A1").Font.Bold = True
        'End With
       
        'Insert the report date
        .Sheets(1).Range("A2").FormulaR1C1 = "Date:"
        'With Selection.Font
            .Sheets(1).Range("A2").Font.Name = "Book Antiqua"
            .Sheets(1).Range("A2").Font.Size = 12
        'End With
        .Sheets(1).Range("B2").NumberFormat = "dd mmmm yyyy"
        .Sheets(1).Range("B2").FormulaR1C1 = Now()
        'With Selection
            .Sheets(1).Range("B2").Font.Name = "Book Antiqua"
            .Sheets(1).Range("B2").Font.Size = 12
        'End With
        .Sheets(1).Range("B2").HorizontalAlignment = xlLeft
       
        'Insert report creator
        .Sheets(1).Range("A3").FormulaR1C1 = "Creator:"
        .Sheets(1).Range("B3").FormulaR1C1 = strGetUserName
        .Sheets(1).Range("A3:B4").Font.Name = "Book Antiqua"
        .Sheets(1).Range("A3:B4").Font.Size = 12
       
    End With
   
    'Close and save the workbook
    xlBook.Save
    xlBook.close
    xlApp.Quit
   
    'Rename the Report
    Name strTempFilename As strFilename
   
    'Done
    Beep
    MsgBox "Excel report has been sucecsfully created", vbOKOnly + vbInformation, "EXPORT COMPLETE..."
   
   
cmdExport_Exit:
    On Error GoTo 0
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    Set xlApp = Nothing
    Set xlBook = Nothing
    Exit Sub

cmdExport_Error:
    Select Case err.Number
    Case 3000
        'Insert Code here
        Resume cmdExport_Exit
    Case Else
        Stop: Resume 'Used for Debugging
        'App_Error "cmdExport"
        Resume cmdExport_Exit
    End Select

End Sub
Private Sub cmdExport2()
'*******************************************************************************
'   What:           -
'   Author:         -   Matthew Mottram - London Productivity Initiative
'   Created:        -   29/04/2002 1:37:12 PM
'   Version:        -   1.00
'*******************************************************************************
On Error GoTo cmdExport2_Error

    Dim strFilename As String
    Dim strTempFilename As String
   
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim rng As Excel.Range
   
    DoCmd.Hourglass True
    DoCmd.SetWarnings False
   
    strFilename = "C:\zzISPN2.xls" 'szFileSaveDlg("Excel Files", "*.xls", "Enter Report Name", False)
    strTempFilename = "C:\zzISPN.xls"
   
    'Exit if the user did not select a filename
    If strFilename = "None" Then err.Raise (3000)
   
    'Export the report
    If blnFileExists(strTempFilename) Then blnDeleteDosFile (strTempFilename)
    If blnFileExists(strFilename) Then
        If MsgBox("This file already exists.@@Do you wish to replace it?", vbQuestion + vbYesNo, "CONFIRM FILE REPLACE") = VBYES Then
            blnDeleteDosFile (strFilename)
        Else
            Exit Sub
        End If
    End If
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "stbl_Globals", strTempFilename, True
    'tbl_Archive_Asset_SPN
   
    'Format the report
    'Set xlApp = New Excel.Application
    Set xlBook = xlApp.Workbooks.Open(strTempFilename)
   
    With xlBook
       
        'Define the data range
        '.Sheets(1).Range("A1").Select
        Set rng = Selection.CurrentRegion
       
        'Insert header rows
        .Sheets(1).Rows("1:4").Insert Shift:=xlDown
       
        'Insert title
        .Sheets(1).Range("A1").FormulaR1C1 = "ASSET SHORT POSITION NETTING"
        .Sheets(1).Range("A1").Select
        'With Selection.Font
            .Sheets(1).Range("A1").Font.Name = "Book Antiqua"
            .Sheets(1).Range("A1").Font.Size = 18
            .Sheets(1).Range("A1").Font.Bold = True
        'End With
       
        'Insert the report date
        .Sheets(1).Range("A2").FormulaR1C1 = "Date:"
        'With Selection.Font
            .Sheets(1).Range("A2").Font.Name = "Book Antiqua"
            .Sheets(1).Range("A2").Font.Size = 12
        'End With
        .Sheets(1).Range("B2").NumberFormat = "dd mmmm yyyy"
        .Sheets(1).Range("B2").FormulaR1C1 = Now()
        'With Selection
            .Sheets(1).Range("B2").Font.Name = "Book Antiqua"
            .Sheets(1).Range("B2").Font.Size = 12
        'End With
        .Sheets(1).Range("B2").HorizontalAlignment = xlLeft
       
        'Insert report creator
        .Sheets(1).Range("A3").FormulaR1C1 = "Creator:"
        .Sheets(1).Range("B3").FormulaR1C1 = strGetUserName
        .Sheets(1).Range("A3:B4").Font.Name = "Book Antiqua"
        .Sheets(1).Range("A3:B4").Font.Size = 12
       
    End With
   
    'Close and save the workbook
    xlBook.Save
    xlBook.close
    xlApp.Quit
   
    'Rename the Report
    Name strTempFilename As strFilename
   
    'Done
    Beep
    MsgBox "Excel report has been sucecsfully created", vbOKOnly + vbInformation, "EXPORT COMPLETE..."
   
cmdExport2_Exit:
    On Error GoTo 0
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    Set rng = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    CloseExcel
    Exit Sub

cmdExport2_Error:
    Select Case err.Number
    Case 3000
        'Insert Code here
        Resume cmdExport2_Exit
    Case Else
        Stop: Resume 'Used for Debugging
        'App_Error "cmdExport2"
        Resume cmdExport2_Exit
    End Select

End Sub
Function blnDeleteDosFile(strFullPath As String) As Boolean
'Deletes a given file, if it exists
On Error GoTo blnDeleteDosFile_Err
   
    blnDeleteDosFile = True
   
    'Delete the file
    Kill strFullPath
   
   
blnDeleteDosFile_Exit:
Exit Function

blnDeleteDosFile_Err:
    Select Case err
    Case 53 ' Error 53 is "File not Found."
        'Just resume without message
    Case 70  'Permission Denied
        blnDeleteDosFile = False
    Case Else
        blnDeleteDosFile = False
    End Select
    Resume blnDeleteDosFile_Exit

End Function
Function blnFileExists(strLocation As String) As Boolean
On Error GoTo blnFileExists_Error
'check to see whether a file exists

Dim strTemp As String

blnFileExists = True
 
strTemp = Dir$(strLocation)

If strTemp = "" Then blnFileExists = False

blnFileExists_Exit:
    On Error GoTo 0
    Exit Function

blnFileExists_Error:
blnFileExists = False
Resume blnFileExists_Exit

End Function
'**********************************************MODULE END