|
|
Our Hot Pick: Rising Antivirus 2006 - Certified by TUV & Checkmark! Get 10% discount by entering this coupon code: ONDISCOUNT10
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!
|
|
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" <GeorgeAtkins[ at ]discussions.microsoft.com> wrote in message
news:27A051AA-796D-4D22-9B9F-7E719E956D71[ at ]microsoft.com...
[Quoted Text] >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!
|
|
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
|
|
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/
--
Ken Snell
<MS ACCESS MVP>
"GeorgeAtkins" <GeorgeAtkins[ at ]discussions.microsoft.com> wrote in message
news:3606C008-627A-434F-86AD-B5E0171FE833[ at ]microsoft.com...
[Quoted Text] > 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,
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
|
|
Do you have a machine with Excel 10 that you can try it on? Maybe it's an
automation issue with 11 only.
Rob
|
|
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.
"Robert Morley" wrote:
[Quoted Text] > Do you have a machine with Excel 10 that you can try it on? Maybe it's an
> automation issue with 11 only.
>
>
> Rob
>
>
>
|
|
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
<MS ACCESS MVP>
"GeorgeAtkins" <GeorgeAtkins[ at ]discussions.microsoft.com> wrote in message
news:31B75189-D4DC-49EC-AB5E-6F300348F685[ at ]microsoft.com...
[Quoted Text] > 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
>
|
|
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.
--
Ken Snell
<MS ACCESS MVP>
"GeorgeAtkins" <GeorgeAtkins[ at ]discussions.microsoft.com> wrote in message
news:2D0AA0DC-2639-49D0-8CA0-E9AA855CE604[ at ]microsoft.com...
[Quoted Text] > 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.
>
> "Robert Morley" wrote:
>
>> Do you have a machine with Excel 10 that you can try it on? Maybe it's
>> an
>> automation issue with 11 only.
>>
>>
>> Rob
>>
>>
>>
|
|
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)" wrote:
[Quoted Text] > 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
> <MS ACCESS MVP>
>
> "GeorgeAtkins" <GeorgeAtkins[ at ]discussions.microsoft.com> wrote in message
> news:31B75189-D4DC-49EC-AB5E-6F300348F685[ at ]microsoft.com...
> > 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
> >
>
>
>
|
|
Looks like a good solution to me! Good luck.
--
Ken Snell
<MS ACCESS MVP>
"GeorgeAtkins" <GeorgeAtkins[ at ]discussions.microsoft.com> wrote in message
news:3B92BC92-8637-46EC-9682-08A4251C59CA[ at ]microsoft.com...
[Quoted Text] > 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)" wrote:
>
>> 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
>> <MS ACCESS MVP>
>>
>> "GeorgeAtkins" <GeorgeAtkins[ at ]discussions.microsoft.com> wrote in message
>> news:31B75189-D4DC-49EC-AB5E-6F300348F685[ at ]microsoft.com...
>> > 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
>> >
>>
>>
>>
|
|
|