Access automation not releasing Excel

D

Dale Fye

I've seen other posts and have been working through them to resolve my
problem. The following code (I've cut some of the fluff) works to loop
through sheets of an Excel workbook and import the data into an Access
database. But will not release Excel. Any help would be greatly appreciated.

Public Sub ExcelLitReviewImport(MyFilename)

Dim xlApp As Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet
Dim rng As Excel.Range

Dim intSheetNum As Integer, strShtName As String, intRowPointer As Integer
Dim strImportRange As String
Dim qdf As DAO.QueryDef
Dim frm As Form

On Error GoTo ExcelLitReviewImportError

Set frm = Forms("frm_Import_Lit_Review")
CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError

'Open Excel and open the workbook to be imported,
frm.lbl_Routine.Visible = True
frm.lbl_Routine.Caption = "Updating Excel file column headers"
DoEvents
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'Open the workbook
Set wbk = xlApp.Workbooks.Open(Filename:=MyFilename, ReadOnly:=False)

'Loop through all of the numbered sheets
DoCmd.Hourglass True
For intSheetNum = 4 To wbk.Sheets.Count

DoEvents

Set sht = wbk.Sheets(intSheetNum)
sht.Activate
strShtName = sht.Name

'If sheet has data, reformat the header row,
'change the worksheet name, import the worksheet
'then change the worksheet name back
If intRowPointer > 1 Then

'Change the column names to correspond with those in
'tbl_Temp_Lit_Review
sht.Cells(1, 1) = "Task"
sht.Cells(1, 1).Hyperlinks.Delete
sht.Cells(1, 2) = "Sub_Task"
sht.Cells(1, 3) = "Source"
sht.Cells(1, 4) = "Pg_Para"
sht.Cells(1, 5) = "Classification"
sht.Cells(1, 6) = "Potential_Gap"
sht.Cells(1, 7) = "D"
sht.Cells(1, 8) = "O"
sht.Cells(1, 9) = "T"
sht.Cells(1, 10) = "M"
sht.Cells(1, 11) = "L"
sht.Cells(1, 12) = "P"
sht.Cells(1, 13) = "F"
sht.Cells(1, 14) = "P2"
sht.Cells(1, 15) = "Reviewer"

'Remove header row formatting
Set rng = Range("A1:O1")
rng.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Set rng = Nothing

'Worksheets are name 1.2.1, 1.3.1, ....
'Could not get method to work with periods in worksheet names
'so changed each sheets name, saved it, imported it, then
'changed it back
sht.Name = "ImportThis"
wbk.Save
strImportRange = "ImportThis!A1:O" & intRowPointer
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl_Temp_Lit_Review", Filename, True,
strImportRange
sht.Name = strShtName

End If
Next

wbk.Save
wbk.Close
xlApp.Quit

End sub
 
N

Norman Yuan

The most poosible reason for Excel being left behind, even Quit() is called,
is because in the current code executing scope there is still variable
referring to objet(s) in Excel object model.

In you case, they are "wbk", "sht" and "rng" variables. at the point when
you call xlApp.Quit(), these 3 variables are still in scope and refers
tothen Workbook, the last Worksheet and the last Range they were assigned
to. They only go out of scope at the end of the Sub, after the Quit() call.

So, you need to explicitly set them (or any variable in scope that points to
an object in Excel object model) to Nothing before calling xlApp.Quit().

This structure of code makes thing easier and clearer:

Public Sub DoExcelAutomation(fileName As String)

Dim xlApp As Excel.Application

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'All variables referring to objects in Excel object model is
'local to DoProcess() method and will go out of scope
'without need to be set to Nothing explicitly

DoProcess xlApp,fileName

xlApp.Quit

End

Private Sub DoProcess(xlApp As Excel.Application, fileName As String)

Dim wbk As Workbook
Dim sht As Worksheet
Dim rng As Range

''Do whatever

''Following code is not necessary
'Set wbk=Nothing
'Set sht=Nothing
'Set rng=Nothing

End
 
D

Dale Fye

Norman,

Thanks for the suggestion. I tried it, but that doesn't seem to do it
either. I even explicitly set the rng, sht, and wbk objects to Nothing
before exiting the subroutine, but Excel is still not being released. New
code looks like:

Public Sub ExcelLitReviewImport(Filename)

Dim xlApp As Object

On Error GoTo ExcelLitReviewImportError

'Open Excel
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'Call the details routine
Call ExcelLitReviewImportDetails(xlApp, Filename)

ExcelLitReviewImportExit:
xlApp.Quit
Set xlApp = Nothing

DoCmd.Hourglass False
Exit Sub

ExcelLitReviewImportError:
If Err.Number = 3022 Then Resume Next
MsgBox Err.Number & vbCrLf & Err.Description, vbInformation + vbOKOnly,
"Error:ExcelLitReviewImport"
Debug.Print "ExcelLitReviewImport", Err.Number, Err.Description
Resume ExcelLitReviewImportExit

End Sub
_____________________
Public Sub ExcelLitReviewImportDetails(xlApp As Object, Filename)

Dim wbk As Object
Dim sht As Object
Dim rng As Object

Dim intSheetNum As Integer, strShtName As String, intRowPointer As Integer
Dim strImportRange As String
Dim frm As Form

On Error GoTo ExcelLitReviewImportDetailsError

Set frm = Forms("frm_Import_Lit_Review")
CurrentDb.Execute "DELETE * FROM tbl_Temp_Lit_Review", dbFailOnError

'Open the workbook
Set wbk = xlApp.Workbooks.Open(Filename:=Filename, ReadOnly:=False)

'Loop through all of the numbered sheets
DoCmd.Hourglass True
For intSheetNum = 4 To wbk.Sheets.Count

Set sht = wbk.Sheets(intSheetNum)
sht.Activate
strShtName = sht.Name
frm.lbl_Routine.Caption = "Importing data from worksheet '" _
& strShtName & "'"
DoEvents

'Fill in the sub-task number for all rows with data
intRowPointer = 1
While sht.Cells(intRowPointer + 1, 3) <> ""
intRowPointer = intRowPointer + 1
sht.Cells(intRowPointer, 2) = strShtName
Wend

'If sheet has data:
' reformat the header row,
' change the worksheet name,
' import the worksheet
' then change the worksheet name back
If intRowPointer > 1 Then

'Change the column names to correspond with those in
'tbl_Temp_Lit_Review
sht.Cells(1, 1) = "Task"
sht.Cells(1, 1).Hyperlinks.Delete
sht.Cells(1, 2) = "Sub_Task"
sht.Cells(1, 3) = "Source"
sht.Cells(1, 4) = "Pg_Para"
sht.Cells(1, 5) = "Classification"
sht.Cells(1, 6) = "Potential_Gap"
sht.Cells(1, 7) = "D"
sht.Cells(1, 8) = "O"
sht.Cells(1, 9) = "T"
sht.Cells(1, 10) = "M"
sht.Cells(1, 11) = "L"
sht.Cells(1, 12) = "P"
sht.Cells(1, 13) = "F"
sht.Cells(1, 14) = "P2"
sht.Cells(1, 15) = "Reviewer"

'Remove header row formatting
Set rng = sht.Range("A1:O1")
rng.Select
xlApp.Selection.Borders(5).LineStyle = -4142
xlApp.Selection.Borders(6).LineStyle = -4142
xlApp.Selection.Borders(7).LineStyle = -4142
xlApp.Selection.Borders(8).LineStyle = -4142
xlApp.Selection.Borders(9).LineStyle = -4142
xlApp.Selection.Borders(10).LineStyle = -4142
xlApp.Selection.Borders(11).LineStyle = -4142
xlApp.Selection.Borders(12).LineStyle = -4142
Set rng = Nothing

sht.Name = "ImportThis"
wbk.Save
strImportRange = "ImportThis!A1:O" & intRowPointer
DoCmd.TransferSpreadsheet acImport, _

acSpreadsheetTypeExcel9, _
"tbl_Temp_Lit_Review", _
Filename, _
True, strImportRange
sht.Name = strShtName

End If
Next

ExcelLitReviewImportDetailsExit:
wbk.Save
Set rng = Nothing
Set sht = Nothing
wbk.Close
Set wbk = Nothing

Exit Sub

ExcelLitReviewImportDetailsError:
If Err.Number = 3022 Then Resume Next
MsgBox Err.Number & vbCrLf & Err.Description, _
vbInformation + vbOKOnly, _
"Error:ExcelLitReviewDetailsImport"
Debug.Print "ExcelLitReviewDetailsImport", Err.Number, Err.Description
Resume ExcelLitReviewImportDetailsExit

End Sub


Dale
 
N

Norman Yuan

I guess it is because you use "DoCmd.TransferSpreadsheet()", which
internally holds reference(s) to object(s) in Excel model.

You could verify it by commentting out the line of code. Since you have
already automated Excel and loop through worksheet/ranges/cells, why do you
need to use DoCmd.TransferSpreadsheet()? Since you already opened Worksheet
and have all data in the sheet in hand, and you are in Access, why not put
the data directly into the table with DAO?

If you have to use DoCmd.TransferSpreadsheet(), you could try to automate
Excel and manipulate sheet/range/cell first, then save the sheet and close
Excel; after that you call DoCmd.TransferSpreadsheet(). Not sure if it
works, but worth trying.
 
D

Dale Fye

Reading data one cell at a time from Excel is tedious, and slow.

It may have something to do with the fact that I am using
TransferSpreadsheet while the workbook is still open. I'll take a look at
that.

Thanks.
--
Don''t forget to rate the post if it was helpful!

email address is invalid
Please reply to newsgroup only.
 
D

Dale Fye

Norman,

I added a couple lines of code:

1. one before the transferspreadsheet that closes the workbook
2. one after the transfrerspreadsheet that reopens it

That resolved the problem.

Thanks for your self.

Dale
--
Don''t forget to rate the post if it was helpful!

email address is invalid
Please reply to newsgroup only.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Fill a multicolumn listbox with data from a range in another works 1
merge worksheets 3
Hlp! Adv Filter - Non-Contiguous rows don't copy 11
Copy all data into one sheet and insert origin data... code amend... 3
Worksheet Calculate 4
Trouble with cell value 4
Looping Help Please 5
Runtime Error 13 - Type Mis-match 4

Top