Solved

Closing the Excel Object after Automation from Access

Posted on 2002-05-09
4
283 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
  • 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

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Join & Write a Comment

This article is a continuation or rather an extension from Cascading Combos (http://www.experts-exchange.com/A_5949.html) and builds on examples developed in detail there. It should be understandable alone, but I recommend reading the previous artic…
Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
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 start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

707 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now