Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > VBA DAO 3.6 Database - How to release resources on the PC after multiple Queries
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1
Default VBA DAO 3.6 Database - How to release resources on the PC after multiple Queries
Hi, I have noticed that my PC's resources are being used
up by making multiple Queries using DAO 3.6 within the
worksheet. It keeps getting larger till teh PC can't
handle anhymore. I've tried closeing the RS and the DB
and also setting the RS and DB to NOTHING, but it does
not release the resources assigned to Excel. Shutting
down Excel also does not appear to correct it when it is
restarted. Only shutting down the PC seems to correct it.

Sample Code Below...

With Worksheets(15)
mMonth = InputBox("Please enter the MONTH of the
Report.", "Northern Trip Monthly Report", Format(Month
(Now) - 1, "#0"))
If Val(mMonth) <= 0 Or Val(mYear) 12 Then Exit Sub
mYear = InputBox("Please enter the YEAR of the
Report.", "Northern Trip Monthly Report", Format(Year
(Now), "#0"))
If mYear < 1 Or mYear 2020 Then Exit Sub
If .Range(.Cells(6, 5).Address).Value = "" Then .Range
(.Cells(6, 5).Address).Value = "1901-01-01"
If .Range(.Cells(6, 6).Address).Value = "" Then .Range
(.Cells(6, 6).Address).Value = "1901-01-01"
'.Range("a6:l300").Select
Dim db As Database
Dim rs As Recordset
Dim rs2 As Recordset
Set db = OpenDatabase(Application.ActiveWorkbook.Path
& "\" & Application.ActiveWorkbook.Name, False,
False, "Excel 5.0;")
Set rs = db.OpenRecordset("Select * from NTDatabase
WHERE RDate =datevalue('" & Format(DateSerial(mYear,
mMonth, 1), "mmm-yyyy") & "') AND RDate < datevalue('" &
Format(DateSerial(mYear, mMonth + 1, 1), "mmm-yyyy")
& "')")

End With
mrow = 5
With Worksheets(Val(mMonth))
.Select
.Range(.Cells(mrow, 1), .Cells(200, 12)).Clear
.Range(.Cells(2, 1).Address).Value = "For the Month
of " & Format(DateSerial(mYear, mMonth, 1), "mmmm") & " "
& Format(DateSerial(mYear, mMonth, 1), "yyyy")
If rs.EOF = False Then

rs.MoveFirst
'MsgBox rs.Fields(1).Name & rs.Fields(2).Name
'MsgBox " Report Date " & rs.Fields!Rdate


While rs.EOF = False

If mrow < 5 Then

If rs.Fields!enumber < .Cells(mrow - 1, 5)
And .Cells(mrow - 1, 5) < "" Then

' ********** SUB Totals **************
.Cells(mrow, 8) = "Total:"
.Cells(mrow, 9) = Format
(costGST, "$###,##0.00")
.Cells(mrow, 10) = Format(costGST * (1 *
1 / 1.07), "$###,##0.00")
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Font.Bold = True
costGST = 0
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Borders(xlEdgeTop).LineStyle = xlSingle
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Borders(xlEdgeBottom).LineStyle = xlDouble

'Sheet1.Range.Clear
.Range(.Cells(mrow, 1), .Cells(mrow,
12)).Interior.Color = 12632256

mrow = mrow + 1
End If

End If
On Error Resume Next
.Cells(mrow, 1) = rs.Fields!lName
.Cells(mrow, 2) = rs.Fields!tName
If UCase(Left(rs.Fields!payType, 1)) = "H"
Then
.Cells(mrow, 3) = "XX"
Else
If UCase(Left(rs.Fields!payType, 1))
= "B" Then .Cells(mrow, 4) = "XX"
End If
.Cells(mrow, 5) = rs.Fields!enumber
.Cells(mrow, 6) = rs.Fields!CC
If IsNull(rs.Fields!TSDate) = False Then
.Cells(mrow, 7) = Format(DateValue
(rs.Fields!TSDate), "yyyy/mm/dd")
'.Cells(mrow, 7) = rs.Fields!TSDate
End If
If IsNull(rs.Fields!TEDate) = False Then
.Cells(mrow, 8) = Format(rs.Fields!
TEDate, "yyyy/mm/dd")
'.Cells(mRow, 8) = rs.Fields!TEDate
End If
.Cells(mrow, 9) = Format(rs.Fields!
cost, "$###,##0.00")
.Cells(mrow, 10) = Format(rs.Fields!cost *
(1 / 1.07), "$###,##0.00")
.Cells(mrow, 11) = rs.Fields!Trip & " of " &
rs.Fields!ofTrip
.Cells(mrow, 12) = rs.Fields!Remarks
costGST = costGST + rs.Fields!cost
mrow = mrow + 1
TotalCost = TotalCost + rs.Fields!cost
rs.MoveNext
Wend
' ********** SUB Totals for last set of employee
Records **************
'mRow = mRow + 1
.Cells(mrow, 8) = "Total:"
.Cells(mrow, 9) = Format
(costGST, "$###,##0.00")
.Cells(mrow, 10) = Format(costGST * (1 *
1 / 1.07), "$###,##0.00")
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Font.Bold = True
'Sheet1.Range.Font.Bold
costGST = 0
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Borders(xlEdgeTop).LineStyle = xlSingle
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Borders(xlEdgeBottom).LineStyle = xlDouble
.Range(.Cells(mrow, 1), .Cells(mrow,
12)).Interior.Color = 12632256

' ***** Grand Totals ************
mrow = mrow + 1
.Cells(mrow, 7) = "Monthly Total:"
.Cells(mrow, 9) = Format(TotalCost, "$###,##0.00")
.Cells(mrow, 10) = Format(TotalCost * (1 * 1 /
1.07), "$###,##0.00")
.Range(.Cells(mrow, 7), .Cells(mrow, 11)).Font.Bold =
True
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeTop).Weight = XlBorderWeight.xlThick
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeBottom).Weight = XlBorderWeight.xlThick
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeBottom).LineStyle = xlDouble
.Range(.Cells(mrow, 1), .Cells(mrow,
12)).Interior.Color = RGB(200, 200, 255)

rs.Close
db.Close

MsgBox "Finished the Report !!", vbOKOnly +
vbInformation
Else
MsgBox "There are no records for " & Format(DateSerial
(mYear, mMonth, 1), "mmm-yyyy") & " in the DataBase. If
this seems incorrect, then update the main Database
before updating the report.", vbOKOnly + vbInformation
End If
End With


Thanks
Earl Brown
Gillam MB, Canada


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 459
Default VBA DAO 3.6 Database - How to release resources on the PC after multiple Queries
If you were using ADO you'd get this effect because of the memory leak
bug:

BUG: Memory Leak Occurs When You Query an Open Excel Worksheet Using
ADO
http://support.microsoft.com/default...;en-us;Q319998

I'm not sure whether the same applies to DAO (the technology is from
before my time!) You are querying the ActiveWorkbook so the source
workbook is definitely open. Something to test would be to change your
code to query a closed copy of your workbook to see if you still get
the problem.

--

"Earl Brown" wrote in message ...
Hi, I have noticed that my PC's resources are being used
up by making multiple Queries using DAO 3.6 within the
worksheet. It keeps getting larger till teh PC can't
handle anhymore. I've tried closeing the RS and the DB
and also setting the RS and DB to NOTHING, but it does
not release the resources assigned to Excel. Shutting
down Excel also does not appear to correct it when it is
restarted. Only shutting down the PC seems to correct it.

Sample Code Below...

With Worksheets(15)
mMonth = InputBox("Please enter the MONTH of the
Report.", "Northern Trip Monthly Report", Format(Month
(Now) - 1, "#0"))
If Val(mMonth) <= 0 Or Val(mYear) 12 Then Exit Sub
mYear = InputBox("Please enter the YEAR of the
Report.", "Northern Trip Monthly Report", Format(Year
(Now), "#0"))
If mYear < 1 Or mYear 2020 Then Exit Sub
If .Range(.Cells(6, 5).Address).Value = "" Then .Range
(.Cells(6, 5).Address).Value = "1901-01-01"
If .Range(.Cells(6, 6).Address).Value = "" Then .Range
(.Cells(6, 6).Address).Value = "1901-01-01"
'.Range("a6:l300").Select
Dim db As Database
Dim rs As Recordset
Dim rs2 As Recordset
Set db = OpenDatabase(Application.ActiveWorkbook.Path
& "\" & Application.ActiveWorkbook.Name, False,
False, "Excel 5.0;")
Set rs = db.OpenRecordset("Select * from NTDatabase
WHERE RDate =datevalue('" & Format(DateSerial(mYear,
mMonth, 1), "mmm-yyyy") & "') AND RDate < datevalue('" &
Format(DateSerial(mYear, mMonth + 1, 1), "mmm-yyyy")
& "')")

End With
mrow = 5
With Worksheets(Val(mMonth))
.Select
.Range(.Cells(mrow, 1), .Cells(200, 12)).Clear
.Range(.Cells(2, 1).Address).Value = "For the Month
of " & Format(DateSerial(mYear, mMonth, 1), "mmmm") & " "
& Format(DateSerial(mYear, mMonth, 1), "yyyy")
If rs.EOF = False Then

rs.MoveFirst
'MsgBox rs.Fields(1).Name & rs.Fields(2).Name
'MsgBox " Report Date " & rs.Fields!Rdate


While rs.EOF = False

If mrow < 5 Then

If rs.Fields!enumber < .Cells(mrow - 1, 5)
And .Cells(mrow - 1, 5) < "" Then

' ********** SUB Totals **************
.Cells(mrow, 8) = "Total:"
.Cells(mrow, 9) = Format
(costGST, "$###,##0.00")
.Cells(mrow, 10) = Format(costGST * (1 *
1 / 1.07), "$###,##0.00")
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Font.Bold = True
costGST = 0
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Borders(xlEdgeTop).LineStyle = xlSingle
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Borders(xlEdgeBottom).LineStyle = xlDouble

'Sheet1.Range.Clear
.Range(.Cells(mrow, 1), .Cells(mrow,
12)).Interior.Color = 12632256

mrow = mrow + 1
End If

End If
On Error Resume Next
.Cells(mrow, 1) = rs.Fields!lName
.Cells(mrow, 2) = rs.Fields!tName
If UCase(Left(rs.Fields!payType, 1)) = "H"
Then
.Cells(mrow, 3) = "XX"
Else
If UCase(Left(rs.Fields!payType, 1))
= "B" Then .Cells(mrow, 4) = "XX"
End If
.Cells(mrow, 5) = rs.Fields!enumber
.Cells(mrow, 6) = rs.Fields!CC
If IsNull(rs.Fields!TSDate) = False Then
.Cells(mrow, 7) = Format(DateValue
(rs.Fields!TSDate), "yyyy/mm/dd")
'.Cells(mrow, 7) = rs.Fields!TSDate
End If
If IsNull(rs.Fields!TEDate) = False Then
.Cells(mrow, 8) = Format(rs.Fields!
TEDate, "yyyy/mm/dd")
'.Cells(mRow, 8) = rs.Fields!TEDate
End If
.Cells(mrow, 9) = Format(rs.Fields!
cost, "$###,##0.00")
.Cells(mrow, 10) = Format(rs.Fields!cost *
(1 / 1.07), "$###,##0.00")
.Cells(mrow, 11) = rs.Fields!Trip & " of " &
rs.Fields!ofTrip
.Cells(mrow, 12) = rs.Fields!Remarks
costGST = costGST + rs.Fields!cost
mrow = mrow + 1
TotalCost = TotalCost + rs.Fields!cost
rs.MoveNext
Wend
' ********** SUB Totals for last set of employee
Records **************
'mRow = mRow + 1
.Cells(mrow, 8) = "Total:"
.Cells(mrow, 9) = Format
(costGST, "$###,##0.00")
.Cells(mrow, 10) = Format(costGST * (1 *
1 / 1.07), "$###,##0.00")
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Font.Bold = True
'Sheet1.Range.Font.Bold
costGST = 0
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Borders(xlEdgeTop).LineStyle = xlSingle
.Range(.Cells(mrow, 8), .Cells(mrow,
11)).Borders(xlEdgeBottom).LineStyle = xlDouble
.Range(.Cells(mrow, 1), .Cells(mrow,
12)).Interior.Color = 12632256

' ***** Grand Totals ************
mrow = mrow + 1
.Cells(mrow, 7) = "Monthly Total:"
.Cells(mrow, 9) = Format(TotalCost, "$###,##0.00")
.Cells(mrow, 10) = Format(TotalCost * (1 * 1 /
1.07), "$###,##0.00")
.Range(.Cells(mrow, 7), .Cells(mrow, 11)).Font.Bold =
True
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeTop).Weight = XlBorderWeight.xlThick
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeBottom).Weight = XlBorderWeight.xlThick
.Range(.Cells(mrow, 1), .Cells(mrow, 12)).Borders
(xlEdgeBottom).LineStyle = xlDouble
.Range(.Cells(mrow, 1), .Cells(mrow,
12)).Interior.Color = RGB(200, 200, 255)

rs.Close
db.Close

MsgBox "Finished the Report !!", vbOKOnly +
vbInformation
Else
MsgBox "There are no records for " & Format(DateSerial
(mYear, mMonth, 1), "mmm-yyyy") & " in the DataBase. If
this seems incorrect, then update the main Database
before updating the report.", vbOKOnly + vbInformation
End If
End With


Thanks
Earl Brown
Gillam MB, Canada
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Import/Export from database queries JudyT Excel Discussion (Misc queries) 0 August 6th 08 07:35 PM
Excel 2003 randomly loosing database queries bmeredyk Excel Discussion (Misc queries) 1 September 25th 07 01:42 AM
Executing queries stored in database in Excel John B Excel Discussion (Misc queries) 0 December 15th 05 09:08 AM
How can I match data about countries drawn from two database queries? tettrick Excel Worksheet Functions 3 August 28th 05 07:00 AM
Multiple Web Queries Andreww[_2_] Excel Programming 3 December 8th 03 10:46 PM


All times are GMT +1. The time now is 06:59 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement