Close Automation Session

[GeorgeAtkins]

I am using Office 2003.
I have an Access database that opens Excel to insert data into a series of
workbooks. The subroutine containing this code is called from within a loop
of another routine. The problem is that when the loop is finished, Excel
Automation objects are still in memory: I open the Task Manager and there
they are! But I thought my code should have closed them. Here is that code:

Sub UpdateExcelFiles(col As Integer, sname As String, att As Single, mbr As
Single, WUnits As Variant)
Dim y As Integer
Dim xlAPP As Excel.Application
Dim xlRange As Excel.Range
Set xlAPP = CreateObject("Excel.Application")
xlAPP.Workbooks.Open "H:\SDL Tracking Sheets\" & sname & ".xls"

For y = 0 To UBound(WUnits, 2) - 1
With xlSheet.Range("CourseIDs")
Set xlRange = .Find(WUnits(0, y))
If Not xlRange Is Nothing Then
xlAPP.Range(xlRange.Address).Select
xlAPP.ActiveCell.Offset(0, 5 + col) = WUnits(1, y)
End If
End With
Next y
xlAPP.Range("AvgAttd").Offset(0, col) = (att / mbr)
xlAPP.ActiveWorkbook.Close True
xlAPP.Application.Quit
Set xlAPP = Nothing
Set xlRange = Nothing
End Sub

******
Ok. What am I doing wrong? Why isn't Excel closing?
And, is there a more efficient way to do this? I mean, should I be opening
and closing the Excel automation object over and over?
Thanks for any tips!

 

[Robert Morley]

Try setting xlRange = Nothing before you close the file and see if that
works.

And to answer your second question, a more efficient way of doing this would
be to declare and open the Excel application outside the update routines,
then once you're done with all the updates, close the app.


Rob

 

[GeorgeAtkins]

Well, I did revise the code to call Excel only once, from the parent routine
as you suggested. That much is good. And on a positive note, only ONE Excel
automation object is left running at the end! Here is what my code looks like
now, minus some minor details:

Sub GetDataForExcel(PeriodCol As Integer)
Dim xlAPP As Excel.Application ' to Neal's excel workbooks
Dim db As DAO.Database
Dim rsStu As DAO.Recordset ' qryTrackingWorksheet_StudentList
Dim rsWrk As DAO.Recordset ' qryTrackingWorksheetUtility
Dim arWU() As Variant ' array of WorkUnit values for classes for
each student

' ****** OPEN THE STUDENT RECORDSET
Set rsStu = db.OpenRecordset(QryStr)
' OPEN EXEL AUTOMATION ONE TIME
Set xlAPP = CreateObject("Excel.Application")

With rsStu
.MoveLast
.MoveFirst
Do Until .EOF ' get each student in recordset
Set rsWrk = db.OpenRecordset(RsWrkFilter) ' open data for student
...code retrieving data from recordset would be here...
With rsWrk
.MoveLast ' populate dataset
.MoveFirst
RecRows = .RecordCount
stuname = rsStu.Fields("Fullname")
' *************************************
' Call subroutine to drop data into Excel file for current
student
' *************************************
UpdateExcelFiles xlAuto:=xlAPP, Col:=XLCol, sname:=stuname,
att:=SumAttd, mbr:=SumMbr, WUnits:=arWU
End With
.MoveNext ' on to next sutdent
Loop
End With
db.Close
' CLOSE EXCEL OLE AUTOMATION AT END OF MAIN ROUTINE
xlAPP.Quit
Set xlAPP = Nothing
End Sub

' *********************************************
' the xlAPP object is passed in as xlAuto argument...

Sub UpdateExcelFiles(xlAuto As Object, Col As Integer, sname As String, att
As Single, mbr As Single, WUnits As Variant)
Dim y As Integer
Dim xlSheet As Excel.Worksheet
Dim xlRange As Excel.Range

xlAuto.Workbooks.Open "H:\SDL Tracking Sheets\" & sname & ".xls"
Set xlSheet = xlAuto.Worksheets(1)

For y = 0 To UBound(WUnits, 2) - 1
With xlSheet.Range("CourseIDs")
Set xlRange = .Find(WUnits(0, y))
If Not xlRange Is Nothing Then
xlAuto.Range(xlRange.Address).Select
xlAuto.ActiveCell.Offset(0, 5 + Col) = WUnits(1, y)
End If
End With
Next y
xlAuto.Range("AvgAttd").Offset(0, Col) = (att / mbr)
' CLOSE RANGE OBJECT FIRST
Set xlRange = Nothing
xlAuto.ActiveWorkbook.Close True
Set xlSheet = Nothing
End Sub

SOOOOOOOOOOO, I must be overlooking something obvious here (as usual).
Thanks for your help so far. Any additional ideas will be appreciated!

- George

 

[Ken Snell \(MVP\)]

If you use CreateObject to open EXCEL application, declare the target
variable as an Object variable, not an EXCEL.Application variable. Change
this line of code:
Dim xlAPP As Excel.Application ' to Neal's excel workbooks

to this:
Dim xlAPP As Object ' to Neal's excel workbooks


Otherwise, if you want to use the EXCEL.Application variable type, change
this line:
Set xlAPP = CreateObject("Excel.Application")

to this:
Set xlAPP = New Excel.Application


The first suggestion is the preferred one (using Object).


Also, in your UpdateExcelFiles sub, you use the reference ActiveWorkbook.
This causes ACCESS to create another reference to EXCEL, which is not using
xlAPP object. This creates a second instance of EXCEL, which probably is
what you see still running after your code is done. Never use partially
qualified objects (such as ActiveCell, ActiveWorkbook, ActiveSheet, etc.)
when automating EXCEL. Always declare objects through your xlAPP object and
its children objects. In this case, I suggest that you add a Workbook object
to the sub and se the opened workbook file to it:
Dim xlWBK As Excel.Workbook
Set xlWBK = xlAuto.Workbooks.Open("H:\SDL Tracking Sheets\" & sname
& ".xls")

Then qualify the worksheet object through the workbook object:
Set xlSheet = xlWBK.Worksheets(1)

Be sure to close the xlWBK object in your code and to set it to Nothing
after you set the worksheet and range objects to Nothing.

See this Microsoft Knowledge Base article for more information about this
"phenomenon" (see the topics "The Problems in Using Unqualified Code with
Office" and "Qualifying the Code to Avoid Errors"):
INFO: Error or Unexpected Behavior with Office Automation When You
Use Early Binding in Visual Basic
http://support.microsoft.com/kb/319832/

 

[GeorgeAtkins]

Ken,
Some great ideas, I appreciate it. HOWEVER... I've changed everything I can
see into a late binding object (having also read that KB article), but I
still get an Excel hanging around memory. Here is my revised code. Perhaps
you (OR ANYBODY ELSE READING THIS) will spot something. Oh, here are the
Library Objects I'm loading, too:
---------------------------------
Visual Basic for Applications
Microsoft Access 11.0 Object Library
Microsoft DAO 3.6 Object Library
OLE Automation
Microsoft Visual Basic for Applications Extensibility 5.3
Microsoft Excel 11.0 Object Library
---------------------------------

Option Compare Database
Option Explicit

Sub GetDataForExcel(PeriodCol As Integer)
Dim xlAPP As Object ' to Neal's excel workbooks
Dim db As DAO.Database
Dim rsStu As DAO.Recordset ' qryTrackingWorksheet_StudentList
Dim rsWrk As DAO.Recordset ' qryTrackingWorksheetUtility

On Error GoTo errhandler
' Prompt user for the current period or column
' * unnecessary code is hidden
Set db = CurrentDb()
QryStr = "SELECT * FROM qryTrackingWorksheet_StudentList WHERE CourseID
='" & CrsNum & _
"' AND SectionID='" & SecNum & "' AND TeacherID=" & TchrNum
Set rsStu = db.OpenRecordset(QryStr)

' Start Excel Automation object
Set xlAPP = CreateObject("Excel.Application")
With rsStu
.MoveLast
.MoveFirst
Do Until .EOF ' get each student
' I hid code to pull data out of Access to put into Excel.....
' Call subroutine to open Excel workbook and input values
UpdateExcelFiles xlAPP, XLCol, StuName, SumAttd, SumMbr, arWU
Loop
End With

GetOut:
Debug.Print "Closing DAO and ending updates"
db.Close
xlAPP.Quit ' Excel automation
Set xlAPP = Nothing
Exit Sub
errhandler:
If Err.Number = 1004 Then
MsgBox "Sorry. This app threw an error: " & Err.Number & " " &
Err.Description
End If
On Error GoTo 0
GoTo GetOut
End Sub

' *********************************************
' Open Excel file for specified student and enter values into specified
column.
' called by GetDataForExcel
' *********************************************
Sub UpdateExcelFiles(xlAuto, Col As Integer, sname As String, att As Single,
Mbr As Single, WUnits As Variant)
Dim y As Integer
Dim xlBook As Object
Dim xlSheet As Object
Dim xlRange As Object

On Error GoTo HandleErrs
Set xlBook = xlAuto.Workbooks.Open("H:\SDL Tracking Sheets\" & sname
& ".xls")
Set xlSheet = xlBook.Worksheets(1)

For y = 0 To UBound(WUnits, 2) - 1
With xlSheet.Range("CourseIDs")
Set xlRange = .Find(WUnits(0, y))
If Not xlRange Is Nothing Then
xlAuto.Range(xlRange.Address).Offset(0, 5 + Col) =
WUnits(1, y)
End If
End With
Next y
xlAuto.Range("AvgAttd").Offset(0, Col) = (att / Mbr)
xlBook.Close SaveChanges:=True
exit_ThisSub:
Debug.Print "Closing Excel for this workbook"
Set xlRange = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Exit Sub
HandleErrs:
Select Case Err.Number
Case 1004
Debug.Print "Looks like a missing range or Excel file for " & sname
Case Else
MsgBox "Error in UpdateExcelfiles: " & Err.Number & " " &
Err.Description
End Select
GoTo exit_ThisSub
End Sub


Thanks again! - George

 

[Robert Morley]

Do you have a machine with Excel 10 that you can try it on? Maybe it's an
automation issue with 11 only.


Rob

 

[GeorgeAtkins]

Thanks again for the good idea, Rob. Unfortunately, I do not have an earlier
version available, and even then it would do me little good. The district
where I work is standardized on 2003 and is not going to go backward, so to
speak. But, I may have to live with the bug, if bug it is.

 

[Ken Snell \(MVP\)]

Try explicitly declaring the variable type as Object in the sub:

Sub UpdateExcelFiles(xlAuto As Object, Col As Integer, sname As String, att
As Single,
Mbr As Single, WUnits As Variant)


And I'd modify the code to use the xlSheet instead of xlAuto in the same
sub. Change this code:
If Not xlRange Is Nothing Then
xlAuto.Range(xlRange.Address).Offset(0, 5 + Col) =
WUnits(1, y)
End If

to this code:
If Not xlRange Is Nothing Then
xlSheet.Range(xlRange.Address).Offset(0, 5 + Col) =
WUnits(1, y)
End If


And change this code:
xlAuto.Range("AvgAttd").Offset(0, Col) = (att / Mbr)

to this:
xlSheet.Range("AvgAttd").Offset(0, Col) = (att / Mbr)


I also would destroy the objects created as children of xlBook before you
close the workbook. Change this code:
xlBook.Close SaveChanges:=True
exit_ThisSub:
Debug.Print "Closing Excel for this workbook"
Set xlRange = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Exit Sub
HandleErrs:
Select Case Err.Number
Case 1004
Debug.Print "Looks like a missing range or Excel file for " & sname
Case Else
MsgBox "Error in UpdateExcelfiles: " & Err.Number & " " &
Err.Description
End Select
GoTo exit_ThisSub
End Sub

to this:
exit_ThisSub:
Set xlRange = Nothing
Set xlSheet = Nothing
xlBook.Close SaveChanges:=True
Debug.Print "Closing Excel for this workbook"
Set xlBook = Nothing
Exit Sub
HandleErrs:
Select Case Err.Number
Case 1004
Debug.Print "Looks like a missing range or Excel file for " & sname
Case Else
MsgBox "Error in UpdateExcelfiles: " & Err.Number & " " &
Err.Description
End Select
GoTo exit_ThisSub
End Sub


I also would remove the reference to Excell 11.0 Library from the
References; not needed any more.

 

[Ken Snell \(MVP\)]

George -

I see that you posted your question in another newsgroup. Did you see my
reply in this thread to the latest info that you provided?

Try explicitly declaring the variable type as Object in the sub:

Sub UpdateExcelFiles(xlAuto As Object, Col As Integer, sname As String, att
As Single,
Mbr As Single, WUnits As Variant)


And I'd modify the code to use the xlSheet instead of xlAuto in the same
sub. Change this code:
If Not xlRange Is Nothing Then
xlAuto.Range(xlRange.Address).Offset(0, 5 + Col) =
WUnits(1, y)
End If

to this code:
If Not xlRange Is Nothing Then
xlSheet.Range(xlRange.Address).Offset(0, 5 + Col) =
WUnits(1, y)
End If


And change this code:
xlAuto.Range("AvgAttd").Offset(0, Col) = (att / Mbr)

to this:
xlSheet.Range("AvgAttd").Offset(0, Col) = (att / Mbr)


I also would destroy the objects created as children of xlBook before you
close the workbook. Change this code:
xlBook.Close SaveChanges:=True
exit_ThisSub:
Debug.Print "Closing Excel for this workbook"
Set xlRange = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Exit Sub
HandleErrs:
Select Case Err.Number
Case 1004
Debug.Print "Looks like a missing range or Excel file for " & sname
Case Else
MsgBox "Error in UpdateExcelfiles: " & Err.Number & " " &
Err.Description
End Select
GoTo exit_ThisSub
End Sub

to this:
exit_ThisSub:
Set xlRange = Nothing
Set xlSheet = Nothing
xlBook.Close SaveChanges:=True
Debug.Print "Closing Excel for this workbook"
Set xlBook = Nothing
Exit Sub
HandleErrs:
Select Case Err.Number
Case 1004
Debug.Print "Looks like a missing range or Excel file for " & sname
Case Else
MsgBox "Error in UpdateExcelfiles: " & Err.Number & " " &
Err.Description
End Select
GoTo exit_ThisSub
End Sub


I also would remove the reference to Excell 11.0 Library from the
References; not needed any more.

 

[GeorgeAtkins]

Hey Ken, thanks for the cleanup tips. I've put them into the code. Odd
getting used to not working with early binding, though. Yet the code is
definitely better.

Funny thing, though, it still failed to close Excel....

I decided that the problem was some place else. Had to be. There had to be
nothing wrong in the main code syntax at this point. Something said by Robert
M. came to mind about a possible bug. While stepping through the code once
again, I watched what happened if one of my Excel files went missing.

I discovered that if this happened, normal exiting by-passed the command to
close the Excel workbook automation object. Stupid oversight. What I did was
to write two escape routes, rather than one, based on trapping error 1004:

' normal escape route, also used by generic error trap
exit_ThisSub:
Debug.Print "Closing Excel for this workbook"
Set xlRange = Nothing
Set xlSearchRange = Nothing
Set xlSheet = Nothing
xlBook.Close SaveChanges:=True
Set xlBook = Nothing
Exit Sub

' second error, called by 1004 error (ie no file to close or save)
exit_NoFile:
Debug.Print "No file, so close variables and try next name"
Set xlRange = Nothing
Set xlSearchRange = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing ' no saving, since no physical file opened!
Exit Sub

HandleErrs:
Select Case Err.Number
Case 1004
Debug.Print "Looks like a missing range or Excel file for " & sname
GoTo exit_NoFile
Case Else
MsgBox "Error in UpdateExcelfiles: " & Err.Number & " " &
Err.Description
GoTo exit_ThisSub
End Select
End Sub
------
I'm not sure this is the best way to handle the situation, but if there is
no Excel file for a particular person in the folder, it is never opened;
hence it cannot be closed. My original code was simply bypassing the problem,
it seems. So I found the "bug" in the code, having eliminated/fixed
everything else.

Anway, thanks a lot to you and to Robert for helping me through this!

George 9/25

 

[Ken Snell \(MVP\)]

Looks like a good solution to me! Good luck.