Database size grows rapidly with frm process

[cchristensen]

I am using the attached code to run a repeatable process; however when
running, the database grows rapidly in size and ultimately reaches 2GB before
completing. I think the issue is that I need to close recordsets, but am
unsure how to write this. Any suggestions?

Option Compare Database

Private Sub BuildStats_Click()
Dim rstStats As New ADODB.Recordset
Dim rstStats2 As New ADODB.Recordset
Dim rstLookupStats As New ADODB.Recordset
Dim lngCount As Long
Dim lngCounter As Long
Dim strSearch As String
Dim dteReOrderDate As Date
Dim strProduct As String
Dim intUnits As Integer
Dim dblProfit As Double
Dim strExpType As String


lblStart.Caption = "Start Time: " & Now

DoEvents
rstStats.Open "qryOtherOrders", CurrentProject.Connection,
adOpenDynamic, adLockOptimistic
rstStats2.Open "qryOtherOrders", CurrentProject.Connection,
adOpenStatic, adLockOptimistic
With rstStats
lngCount = rstStats2.RecordCount
rstStats2.Close
Set rstStats2 = Nothing
.MoveFirst
lngCounter = 1
Do While Not .EOF
strSQL = "SELECT * FROM [All Orders] WHERE [Account No] = " &
![Account No] & " AND [Invoice Period Date] >= #" & 14 + ![Invoice Period
Date] & "#"
rstLookupStats.Open strSQL, CurrentProject.Connection,
adOpenStatic
If Not rstLookupStats.EOF Then
dteReOrderDate = rstLookupStats![Invoice Period Date]
strProduct = rstLookupStats![MPC Name]
intUnits = rstLookupStats![Total Product Invoice Unit Count]
dblProfit = rstLookupStats![Profit]
strExpType = rstLookupStats![Expense Type Name]
![Order Retained] = True
![Reorder Date] = dteReOrderDate
![Days to reorder] = DateDiff("d", ![Invoice Period Date],
dteReOrderDate)
![Reorder Product] = strProduct
![Reorder Units] = intUnits
![Reorder Profit] = dblProfit
![Reorder Expense Type] = strExpType
.Update
End If
rstLookupStats.Close
lblRecCount.Caption = "Record Count: " & lngCounter & " of " &
lngCount
DoEvents
lngCounter = lngCounter + 1
.MoveNext
Loop
.Close
End With
Set rstLookupStats = Nothing
Set rstStats = Nothing
lblEnd.Caption = "End Time: " & Now
DoEvents
End Sub

Private Sub Form_Load()
lblRecCount.Caption = ""
lblStart.Caption = ""
lblEnd.Caption = ""
End Sub

 

[Jerry Whittle]

Instead of the code, couldn't you just gather what you want with a simple
query? If I'm reading the code correctly, a Totals query might do the job.

 

[a a r o n . k e m p f]

Jet consistently bloats.

It is not reccomended to use Jet.
most of the people around here are going to reccomend that you have
THREE DIFFERENT TIERS of jet databases-- but this is even more
inefficient.

SQL Server doesn't bloat.

Anyone with a clue moved to SQL Server a decade ago.

I am using the attached code to run a repeatable process; however when
running, the database grows rapidly in size and ultimately reaches 2GB before
completing.  I think the issue is that I need to close recordsets, but am
unsure how to write this.  Any suggestions?

Option Compare Database

Private Sub BuildStats_Click()
    Dim rstStats As New ADODB.Recordset
    Dim rstStats2 As New ADODB.Recordset
    Dim rstLookupStats As New ADODB.Recordset
    Dim lngCount As Long
    Dim lngCounter As Long
    Dim strSearch As String
    Dim dteReOrderDate As Date
    Dim strProduct As String
    Dim intUnits As Integer
    Dim dblProfit As Double
    Dim strExpType As String

    lblStart.Caption = "Start Time: " & Now

    DoEvents
    rstStats.Open "qryOtherOrders", CurrentProject.Connection,
adOpenDynamic, adLockOptimistic
    rstStats2.Open "qryOtherOrders", CurrentProject.Connection,
adOpenStatic, adLockOptimistic
    With rstStats
        lngCount = rstStats2.RecordCount
        rstStats2.Close
        Set rstStats2 = Nothing
        .MoveFirst
        lngCounter = 1
        Do While Not .EOF
            strSQL = "SELECT * FROM [All Orders] WHERE [Account No] = " &
![Account No] & " AND [Invoice Period Date] >= #" & 14 + ![Invoice Period
Date] & "#"
            rstLookupStats.Open strSQL, CurrentProject.Connection,
adOpenStatic
            If Not rstLookupStats.EOF Then
                dteReOrderDate = rstLookupStats![Invoice Period Date]
                strProduct = rstLookupStats![MPC Name]
                intUnits = rstLookupStats![Total Product Invoice Unit Count]
                dblProfit = rstLookupStats![Profit]
                strExpType = rstLookupStats![Expense Type Name]
                ![Order Retained] = True
                ![Reorder Date] = dteReOrderDate
                ![Days to reorder] = DateDiff("d", ![Invoice Period Date],
dteReOrderDate)
                ![Reorder Product] = strProduct
                ![Reorder Units] = intUnits
                ![Reorder Profit] = dblProfit
                ![Reorder Expense Type] = strExpType
                .Update
            End If
            rstLookupStats.Close
            lblRecCount.Caption = "Record Count: " & lngCounter & " of " &
lngCount
            DoEvents
            lngCounter = lngCounter + 1
            .MoveNext
        Loop
        .Close
    End With
    Set rstLookupStats = Nothing
    Set rstStats = Nothing
    lblEnd.Caption = "End Time: " & Now
    DoEvents
End Sub

Private Sub Form_Load()
lblRecCount.Caption = ""
lblStart.Caption = ""
lblEnd.Caption = ""
End Sub