Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Closing the Excel Object after Automation from Access

Posted on 2002-05-09
4
Medium Priority
?
326 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 750 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

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

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

In earlier versions of Windows (XP and before), you could drag a database to the taskbar, where it would appear as a taskbar icon to open that database.  This article shows how to recreate this functionality in Windows 7 through 10.
The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

715 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