See latest reply in microsoft.public.access.modulesdaovba.ado newsgroup.
--
Ken Snell
<MS ACCESS MVP>
"GeorgeAtkins" <GeorgeAtkins[ at ]discussions.microsoft.com> wrote in message
news:7691022B-0312-4289-A1ED-3C90AA6FD612[ at ]microsoft.com...
[Quoted Text] > Howdy,
> I have gotten some good advise from Ken Snell, but I need a bit more.
> Using
> Office 2003, I am using Access to put data into a series of Excel files.
> The
> problem is that Excel is left running in memory when done. I've gone
> through
> my code and tried to ensure all late binding was used, all Excel ranges
> referenced through automation objects, etc.. Still, Excel remains loaded
> in
> Task Manager when done. Here is the main parts of my code, along with a
> list
> of loaded libraries. If anybody sees something I've overlooked, please let
> me
> know. Thanks, George
>
> ------------------------
> 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
>
>
|