Solved

Closing the Excel Object after Automation from Access

Posted on 2002-05-09
4
317 Views
Last Modified: 2012-06-22
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
0
Comment
Question by:mattmott
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 1

Expert Comment

by:dougp23
ID: 6999286
I also have noticed quirky behavior when working with Excel and Access like you are doing.  My solution has been to ALWAYS use a range.  I specify the range as something ludicrous (A1:AZ20000).  If the actual range is smaller, Excel doesn't care.

Just a thought, you might want to try it.
0
 
LVL 9

Accepted Solution

by:
perove earned 250 total points
ID: 7011731
The reason is that Excel is a bit "tricky" when it comes to been' automated'..You problem is not the range object but how you assign values to it.

(The object you are refencing are not exclusive to XL.)

Therefore use a fully.name.qualification
:-)


Well sorry my poor english,take a look this testfunction


Function Bullshit()
   Dim xlApp As Excel.Application
   Dim xlBook As Workbook
   Dim rng As Excel.Range
   
    Set xlApp = New Excel.Application
    Set xlBook = xlApp.Workbooks.Open("c:\zzISPN.xls")

    xlBook.Sheets(1).Range("A1").Font.Name = "Book Antiqua"
    xlBook.Sheets(1).Range("A1").Font.Size = 26
    xlBook.Sheets(1).Range("A1").Font.Bold = True
'This line will release XL from memory
    'Set rng = xlApp.Selection.CurrentRegion
'THis line will NOT release XL from memory
    'Set rng = Selection.CurrentRegion

xlBook.Close

End Function


Play with this function and you'll see what I mean. I'm sure.

perove


 
0
 

Author Comment

by:mattmott
ID: 7069319
Hi Perove

Thanks for this, I am busy testing the results and will get back to you, preliminary results are promising though ;)

Matt
0
 

Author Comment

by:mattmott
ID: 7214694
Thanks Perove, Sorry for the delay, had this working a while back but haven't been back to EE to award the points.
0

Featured Post

Simplifying Server Workload Migrations

This use case outlines the migration challenges that organizations face and how the Acronis AnyData Engine supports physical-to-physical (P2P), physical-to-virtual (P2V), virtual to physical (V2P), and cross-virtual (V2V) migration scenarios to address these challenges.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

628 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question