Solved

Closing the Excel Object after Automation from Access

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

In the previous article, Using a Critera Form to Filter Records (http://www.experts-exchange.com/A_6069.html), the form was basically a data container storing user input, which queries and other database objects could read. The form had to remain op…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

932 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

11 Experts available now in Live!

Get 1:1 Help Now