Can't unload Excel from RAM after import to Access

[Creosote65]

Hi all,

I hope that this question hasn't been asked before, so here goes:

I have a vba routine that opens an Excel spreadsheet, manipulates the data, saves the changes, then performs the 'transferspreadsheet' command.

I run this routine from a menu button. At the beginning and end, I have confirmation popups that show the user that everything went well. I also included error handling for error type 1004, which happens when the user tries to re-use the same file. I also tried to include error handling for error 91, but I cannot bypass the standard vba error popup ("end", "debug").

From the point at which I get error 91, everything goes really screwy. The origin of my problem is that, although I included the close file "ActiveWorkbook.Close")and quit commands ("appExcel.Quit"), There remains an instance of Excel sitting in RAM, doing nothing. Sometimes it's more than one instance.

Sometimes, I find that closing Access will resolve the problem, but not as a rule. Sometimes I'll open Excel and will find my previous files sitting in auto recovery.

My question is: can I do anything in vba to kill all instances of Excel, visible or not.

Thanks in advance,
Creo!

 

[glalsop]

Perhaps you could post the code that you are using to manipulate the Excel workbook?

Although it is usually possible to locate and kill open instances of applications, it is probably a bad idea to do so haphazardly. What if I am doing something in Excel, and minimize it for a moment to run your code? Are you going to terminate what I was doing? Probably best to attempt to track down the error in your code that is leaving instances of Excel open.

-Gary

 

[Creosote65]

Hi Gary,

Thanks for the prompt response. Here is the whole routine. If you have any questions concerning any of it, just reply. Thanks in advance for any clarity you can bring to this malfunction.

-Creo

Private Sub cmdImport_Click()
Dim appExcel As Excel.Application
Set appExcel = New Excel.Application
Dim strRange As String
Dim strReqNo As String
Dim Msg, Style, Title, Response, MyString
On Error GoTo ImportError

Msg = "Importing a file more than once will cause errors. Do you wish to proceed?" ' Define message.
Style = vbYesNo + vbExclamation + vbDefaultButton2 ' Define buttons.
Title = "Import single proposal" ' Define title.

' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
MyString = "Yes" ' Perform import.
appExcel.Workbooks.Open "C:\EmailQuote\qryExportQuote.xls"
appExcel.Visible = False
Worksheets(1).Select
Sheets(1).Name = "Header"
Sheets("Header").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Move After:=Sheets(2)
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "ItemDetails"
ActiveSheet.Previous.Select
Columns("A:F").Select
Selection.Copy
ActiveSheet.Next.Select
ActiveSheet.Paste
Range("A1").Select
ActiveSheet.Previous.Select
Columns("B:F").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Range("A1", Selection.End(xlDown)).Offset(2, 0).Select
Selection.EntireRow.Delete Shift:=xlUp
Columns("C:H").Select
Selection.NumberFormat = "@"
Columns("K:K").Select
Selection.NumberFormat = "@"
Columns("O:O").Select
Selection.NumberFormat = "@"
Columns("L:M").Select
Selection.NumberFormat = "m/d/yyyy"
strRange = Range("A1", Selection.End(xlDown).End(xlToRight)).Select
Columns("A:A").Select
Selection.Delete
ActiveWorkbook.Names.Add Name:="Header", RefersTo:="=Header!$A$1:$N$2"
ActiveWorkbook.Names.Add Name:="ItemDetails", RefersTo:="=ItemDetails!$A$1:$F$3000"
ActiveWorkbook.Names.Add Name:="ReqNoDetails", RefersTo:="=ItemDetails!$A$1:$a$2"
Range("A1").Select
ActiveWorkbook.Save
DoCmd.TransferSpreadsheet acImport, , "tblInputHeader", _
"c:\EmailQuote\qryExportQuote.xls", True, "Header"
ActiveWorkbook.Close
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryMaxReqNo"
DoCmd.TransferSpreadsheet acExport, , "tblMaxReqNo", _
"C:\EmailQuote\qryReqNo.xls", True
Workbooks.Open "C:\EmailQuote\qryExportQuote.xls"
Workbooks.Open "C:\EmailQuote\qryReqNo.xls"
Range("A2").Select
Selection.Copy
Windows("qryExportQuote.xls").Activate
ActiveSheet.Next.Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
ActiveWorkbook.Close
DoCmd.TransferSpreadsheet acImport, , "tblInputItemDetail", _
"c:\EmailQuote\qryExportQuote.xls", True, "ItemDetails"
DoCmd.OpenQuery "qryDeleteBlanksInputDetail"
appExcel.Quit
MsgBox "Import was successful.", vbInformation
Else ' User chose No.
MyString = "No" ' Confirm cancellation!
MsgBox "Import was cancelled.", vbInformation
End If

ImportError:
If Err.Number = 1004 Then
'The same import file was reused."
MsgBox "You have reused the same import file as the last time. Please replace the file and re-import it. It is recommended that you exit and reenter this application before proceeding.", vbExclamation, "Import Error"
ActiveWorkbook.Close SaveChanges:=False
appExcel.Quit
ElseIf Err.Number = 91 Then
'The same import file was reused."
MsgBox "You must exit and restart Access. You must also change the Excel import file.", vbExclamation, "Import Error"
ActiveWorkbook.Close SaveChanges:=False
appExcel.Quit
End If

 

[glalsop]

I suspect that part of your problem may stem from the fact that you are always creating a new instance of Excel, regardless of what is already running on the machine. Have a look at this link:

http://mvps.org/access/modules/mdl0006.htm

Note that at the top of this page there is a link to another module that you will need to create for it to function properly. These functions will allow you to check for a running instance of Excel. If one is open, you can use that instance rather than creating a new one.

While debugging, you may also find it useful to place the Excel script from this link on your desktop:

http://peltiertech.com/Excel/scripts.html

It will round up those hidden instances that you will inevitably leave open while you are getting everything working properly.

-Gary

 

[CajunCenturion]

There are a couple of reasons why this may be happening. First, you are only closing the ActiveWorkbook (in one case twice), and that is fine is if you can guarantee that only one workbook will be open. To close all of the workbooks,

appExcel.Workbooks.Close

Secondly, it looks like you are still leaving a reference pointer to the Excel application active because you are not setting your appExcel object to nothing. I would first try the following after each quit:

appExcel.Quit
Set appExcel = Nothing

Also, as the code is shown, you will always trop into your error handler, and it is not clear where you are resetting the Error object with a proper Resume statement. I also cannot find the End Sub statement.

Good Luck
--------------
To get the most from your Tek-Tips experience, please read FAQ181-2886
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein

 

[PHV]

In addition to the good remarks of CajunCenturion, one big problem too is the LOT of implicit instantiation of the Excel.Application object.
You may consider this:
With appExcel
.Worksheets(1).Select
.Sheets(1).Name = "Header"
...
.Range("A1").Select
.ActiveWorkbook.Save
.Workbooks.Close
End With

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[Creosote65]

Hey guys,

A tremendous thank you to all three of you. You have resolved my issue of the multiple instances of Excel.

However, as I watch the task manager, I notice that the process that was either created or used during the Access session remains running in memory, after I've closed Access. When I re-open Access with a new file, I get the popup telling me that I am trying to re-use the same file from the last session.

It's as if Access still sees the file that's loaded in memory, which I can't seem to get out of memory without killing the application through task manager.

Even when I run the "XLcheck" vbs file and bring Excel to screen, then close it, the process stays in memory.

Please help...

Creo

Here is the whole thing... some lines were changed to comments because I believe that they are not need in may case.

Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10
Private objXL As Object
Private strWhat As String, boolXL As Boolean
Private objActiveWkb As Object


Private Declare Function apiFindWindow Lib "user32" Alias _
"FindWindowA" (ByVal strClass As String, _
ByVal lpWindow As String) As Long

Private Declare Function apiSendMessage Lib "user32" Alias _
"SendMessageA" (ByVal Hwnd As Long, ByVal Msg As Long, ByVal _
wParam As Long, lParam As Long) As Long

Private Declare Function apiSetForegroundWindow Lib "user32" Alias _
"SetForegroundWindow" (ByVal Hwnd As Long) As Long

Private Declare Function apiShowWindow Lib "user32" Alias _
"ShowWindow" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function apiIsIconic Lib "user32" Alias _
"IsIconic" (ByVal Hwnd As Long) As Long

Function fIsAppRunning(ByVal strAppName As String, _
Optional fActivate As Boolean) As Boolean
Dim lngH As Long, strClassName As String
Dim lngX As Long, lngTmp As Long
Const WM_USER = 1024
On Local Error GoTo fIsAppRunning_Err
fIsAppRunning = False
Select Case LCase$(strAppName)
Case "excel": strClassName = "XLMain"
Case Else: strClassName = vbNullString
End Select

If strClassName = "" Then
lngH = apiFindWindow(vbNullString, strAppName)
Else
lngH = apiFindWindow(strClassName, vbNullString)
End If
If lngH <> 0 Then
apiSendMessage lngH, WM_USER + 18, 0, 0
lngX = apiIsIconic(lngH)
If lngX <> 0 Then
lngTmp = apiShowWindow(lngH, SW_SHOWNORMAL)
End If
If fActivate Then
lngTmp = apiSetForegroundWindow(lngH)
End If
fIsAppRunning = True
End If
fIsAppRunning_Exit:
Exit Function
fIsAppRunning_Err:
fIsAppRunning = False
Resume fIsAppRunning_Exit
End Function


Private Sub cmdImport_Click()
Dim strRange As String
Dim strReqNo As String
Dim Msg, Style, Title, Response, MyString
On Error GoTo ImportError

Msg = "Importing a file more than once will cause errors. Do you wish to proceed?" ' message.
Style = vbYesNo + vbExclamation + vbDefaultButton2 ' buttons.
Title = "Import single proposal" ' title.

' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
MyString = "Yes" ' Perform import.
sTestXL 'call the Excel test sub
objXL.Workbooks.Open "C:\EmailQuote\qryExportQuote.xls"
objXL.Visible = False
Worksheets(1).Select
Sheets(1).Name = "Header"
Sheets("Header").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Move After:=Sheets(2)
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "ItemDetails"
ActiveSheet.Previous.Select
Columns("A:F").Select
Selection.Copy
ActiveSheet.Next.Select
ActiveSheet.Paste
Range("A1").Select
ActiveSheet.Previous.Select
Columns("B:F").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Range("A1", Selection.End(xlDown)).Offset(2, 0).Select
Selection.EntireRow.Delete Shift:=xlUp
Columns("C:H").Select
Selection.NumberFormat = "@"
Columns("K:K").Select
Selection.NumberFormat = "@"
Columns("O:O").Select
Selection.NumberFormat = "@"
Columns("L:M").Select
Selection.NumberFormat = "m/d/yyyy"
strRange = Range("A1", Selection.End(xlDown).End(xlToRight)).Select
Columns("A:A").Select
Selection.Delete
ActiveWorkbook.Names.Add Name:="Header", RefersTo:="=Header!$A$1:$N$2"
ActiveWorkbook.Names.Add Name:="ItemDetails", RefersTo:="=ItemDetails!$A$1:$F$3000"
ActiveWorkbook.Names.Add Name:="ReqNoDetails", RefersTo:="=ItemDetails!$A$1:$a$2"
Range("A1").Select
ActiveWorkbook.Save
DoCmd.TransferSpreadsheet acImport, , "tblInputHeader", _
"c:\EmailQuote\qryExportQuote.xls", True, "Header"
ActiveWorkbook.Close
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryMaxReqNo"
DoCmd.TransferSpreadsheet acExport, , "tblMaxReqNo", _
"C:\EmailQuote\qryReqNo.xls", True
Workbooks.Open "C:\EmailQuote\qryExportQuote.xls"
Workbooks.Open "C:\EmailQuote\qryReqNo.xls"
Range("A2").Select
Selection.Copy
Windows("qryExportQuote.xls").Activate
ActiveSheet.Next.Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
ActiveWorkbook.Save
Workbooks.Close
DoCmd.TransferSpreadsheet acImport, , "tblInputItemDetail", _
"c:\EmailQuote\qryExportQuote.xls", True, "ItemDetails"
DoCmd.OpenQuery "qryDeleteBlanksInputDetail"
DoCmd.DeleteObject acTable, "ItemDetails_ImportErrors"
objXL.Quit
Set objXL = Nothing
MsgBox "Import was successful.", vbInformation
Else ' User chose No.
MyString = "No" ' Perform some action. None!
MsgBox "Import was cancelled.", vbInformation
End If

ImportError:
If Err.Number = 1004 Then
'The same import file was reused."
MsgBox "You have reused the same import file as the last time. Please replace the file and re-import it. It is recommended that you exit and reenter this application before proceeding.", vbExclamation, "Import Error"
'ActiveWorkbook.Save
'objXL.Workbooks.Close savechanges:=False
objXL.Quit 'savechanges:=False
Set objXL = Nothing
ElseIf Err.Number = 91 Then
'The same import file was reused."
MsgBox "You must exit and restart Access. You must also change the Excel import file.", vbExclamation, "Import Error"
ActiveWorkbook.Close savechanges:=False
objXL.Quit
End If
End Sub

Sub sTestXL()

If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If

'objXL.Application.Workbooks.Add
Set objActiveWkb = objXL.Application.ActiveWorkbook

'With objActiveWkb
' .Worksheets(1).Cells(1, 1) = "Hello World"
' strWhat = .Worksheets(1).Cells(1, 1).Value
'End With

'objActiveWkb.Close savechanges:=False

If boolXL Then objXL.Application.Quit

'Set objActiveWkb = Nothing: Set objXL = Nothing
'MsgBox strWhat
End Sub

 

[PHV]

Reread carefully my previous post, as you have a LOT of implicit instantiations of Excel objects.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[Creosote65]

Hey PHV!

Thanks for the advice, at first I didn't think that it was necessary. I did what you said and broke it down, then created 2 "With" statements for Excel, closing the application each time. It seems to have worked out. The Excel process just disappears for RAM.

You have just saved my a**, as well as my reputation. Thanks. Thanks to all who helped.

Creosote

 

[RLB2]

Creosote65,

Can you post your working code so I can see the before and after. A big help! Thanks!

Rob

 

[Creosote65]

Hey Rob,

Although this code is not perfect (users have had errors when they already have a session of Excel open), my immediate RAM concerns were resolved. It creates a really transparent and effortless Excel to Access import subroutine. The instantiation of Excel created during the process is killed at the end, and that was the point.

Good luck,
Creo...

Private Sub cmdImport_Click()
Dim strRange As String
Dim strReqNo As String
Dim Msg, Style, Title, Response, MyString
On Error GoTo ImportError

Msg = "Importing a file more than once will cause errors. You MUST close all open sessions of Excel. Do you wish to proceed?" ' message.
Style = vbYesNo + vbExclamation + vbDefaultButton2 ' buttons.
Title = "Import single proposal" ' title.

' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
MyString = "Yes" ' Perform import.
sTestXL 'call the Excel test sub
With objXL
.Workbooks.Open "C:\EmailQuote\qryExportQuote.xls"
'.Visible = True
.Worksheets(1).Select
.Sheets(1).Name = "Header"
.Sheets("Header").Select
.Sheets.Add
.Sheets("Sheet1").Select
.Sheets("Sheet1").Move After:=Sheets(2)
.Sheets("Sheet1").Select
.Sheets("Sheet1").Name = "ItemDetails"
.ActiveSheet.Previous.Select
.Columns("A:G").Select
.Selection.Copy
.ActiveSheet.Next.Select
.ActiveSheet.Paste
.Range("A1").Select
.ActiveSheet.Previous.Select
.Columns("B:G").Select
.Selection.Delete Shift:=xlToLeft
.ActiveSheet.Range("A1", Selection.End(xlDown)).Offset(2, 0).Select
.Selection.EntireRow.Delete Shift:=xlUp
.Columns("D:I").Select
.Selection.NumberFormat = "@"
.Columns("B:B").Select
.Selection.NumberFormat = "@"
.Columns("L:L").Select
.Selection.NumberFormat = "@"
.Columns("P").Select
.Selection.NumberFormat = "@"
.Columns("M:N").Select
.Selection.NumberFormat = "m/d/yyyy"
.Columns("A:A").Select
.Selection.Delete
.ActiveWorkbook.Names.Add Name:="Header", RefersTo:="=Header!$A$1:$O$2"
.ActiveWorkbook.Names.Add Name:="ItemDetails", RefersTo:="=ItemDetails!$A$1:$G$3000"
.ActiveWorkbook.Names.Add Name:="ReqNoDetails", RefersTo:="=ItemDetails!$A$1:$A$2"
.Range("A1").Select
.ActiveWorkbook.Save
End With
objXL.Quit
Set objXL = Nothing

DoCmd.TransferSpreadsheet acImport, , "tblInputHeader", _
"c:\EmailQuote\qryExportQuote.xls", True, "Header"
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryMaxReqNo"
DoCmd.TransferSpreadsheet acExport, , "tblMaxReqNo", _
"C:\EmailQuote\qryReqNo.xls", True

sTestXL 'call the Excel test sub
With objXL
.Workbooks.Open "C:\EmailQuote\qryExportQuote.xls"
.Workbooks.Open "C:\EmailQuote\qryReqNo.xls"
'.Visible = True
.Range("A2").Select
.Selection.Copy
.Windows("qryExportQuote.xls").Activate
.ActiveSheet.Next.Select
.Range("A2").Select
.Range(Selection, Selection.End(xlDown)).Select
.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Range("A1").Select
.ActiveWorkbook.Save
.Workbooks.Close
End With
objXL.Quit
Set objXL = Nothing

DoCmd.TransferSpreadsheet acImport, , "tblInputItemDetail", _
"c:\EmailQuote\qryExportQuote.xls", True, "ItemDetails"
DoCmd.OpenQuery "qryDeleteBlanksInputDetail"
DoCmd.DeleteObject acTable, "ItemDetails_ImportErrors"
MsgBox "Import was successful.", vbInformation
Else ' User chose No.
MyString = "No" ' Perform some action. None!
MsgBox "Import was cancelled.", vbInformation
End If

ImportError:
If Err.Number = 1004 Then
'The same import file was reused."
MsgBox "You have reused the same import file as the last time. Please replace the file and re-import it. It is recommended that you exit and reenter this application before proceeding.", vbExclamation, "Import Error"
ActiveWorkbook.Save
objXL.Quit
Set objXL = Nothing
ElseIf Err.Number = 91 Then
'The same import file was reused."
MsgBox "You must exit and restart Access. You must also change the Excel import file.", vbExclamation, "Import Error"
ActiveWorkbook.Close Savechanges:=False
objXL.Quit
End If
End Sub

There is also this subroutine that is called, which tests for an existing instation of Excel, but it doesn't seem to be 100%

Sub sTestXL()

If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If

objXL.Application.Workbooks.Add
Set objActiveWkb = objXL.Application.ActiveWorkbook

If boolXL Then objXL.Application.Quit

End Sub

 

[RLB2]

Thanks!

I'll check it out!

Rob

 

[RoyVidar]

You may try the following:

[tt]Sub sTestXL()
on error resume next
Set objXL = GetObject(, "Excel.Application")
if err.number<>0 then
' no instance of excel, create one
err.clear
Set objXL = CreateObject("Excel.Application")
if err.number<>0 then
' Excel installed?
exit sub
end if
end if
' NOTE
' objXL.Application.Workbooks.Add <- don't use this
Set objActiveWkb = objXL.Worbooks.Add
End Sub[/tt]

Also in the errorhandler, you have implicit/unqualified referencing:

[tt]ActiveWorkbook.Save ' try
objXL.ActiveWorkbook.Save ' instead[/tt]

And
[tt]ActiveWorkbook.Close Savechanges:=False ' try
objXL.ActiveWorkbook.Close Savechanges:=False[/tt]

And in the main routine:
[tt].Sheets("Sheet1").Move After:=Sheets(2) ' try
.Sheets("Sheet1").Move After:=.Sheets(2) ' dot - .Sheets(2)[/tt]

And
[tt].ActiveSheet.Range("A1", Selection.End(xlDown)).Offset(2, 0).Select ' try:
.ActiveSheet.Range("A1", .Selection.End(xlDown)).Offset(2, 0).Select
' dot .selection...[/tt]

Don't know if I've found all...

Also, I think I'd probably assigned the two workbooks to workbook object variables:

[tt].Workbooks.Open "C:\EmailQuote\qryExportQuote.xls"
.Workbooks.Open "C:\EmailQuote\qryReqNo.xls"

set wrkExpQutoe=.Workbooks.Open "C:\EmailQuote\qryExportQuote.xls"
set wrkReqNo=.Workbooks.Open "C:\EmailQuote\qryReqNo.xls"[/tt]

Though I'm not sure this would provide any errors, it's just a bit more "safe" (but that's perhaps just my stubborn opinion/preference;-))

Roy-Vidar