System Resources Exceeded Error

[A3Kluth]

I have created a module that uses multiple arrays to check transaction dates for the same order number and keep getting a System Resources Exceeded Error. I am using MS ACCESS 2010. I then have to stop the code and do a compact and repair which isn't a big issue except when I do this the code (which normally runs in about 3 minutes) takes hours to complete about 130,000 records. When this happens the database becomes useless and I have to try again with a backup. I think it has something to do with the memory possibly getting filled with the arrays but don't know how to fix. Here are the example of the array variables:
Dim DtEffDate(90) As Date
Dim DtEndDate(90) As Date


All I am doing is comparing DtEffDate(1) with DtEndDate(2) to check for gaps between the records.

Once I have completed the comparison for one order number I set the variables to this:
DtEffDate(RowID) = Empty
DtEndDate(RowID) = Empty


Does anybody have an idea of what I might be doing wrong?

Thanks

 

[theDBguy]

Hi. If you're having problems with your code, it might help us to help you if you could post said code here. Better yet, maybe you could consider posting a small demo version of your db with test data. Just a thought...

 

[jdraw]

Agree with DBGuy -- please post a copy of the database with any descriptive material to tell us the purpose of the database and instructions to get to the problem area.

 

[CJ_London]

From the brief description of what you are trying to do, which is a common requirement , it sounds like you could do this in a query

 

[The_Doc_Man]

The question in my mind is basically how many times you do what you do. How OFTEN (in one run) do you load and unload your arrays? Once? Once per record? Once per some specific group of records? The problem is that memory is limited by several factors.

1. Physical RAM on your machine - when that is gone, so is your process.
2. Virtual RAM settings (in your System Performance Settings). When you exhaust virtual memory, that's the end of the run.
3. Whether you approach 2 GB virtual memory and have a 32-bit version of Access. A 32-bit address space supports 4 GB, but Access takes half of that for itself and the other half becomes virtual memory for the actual data. If you slam into the 2 Gb capacity limit, you stop. Dead stop.

The mechanism for populating and repopulating memory arrays involves manipulation of a structure called an array descriptor. What this array descriptor actually describes will depend on the array and to be honest, a LOT of this is part of the MicroSoft "black box" that makes debugging this problem difficult. In any case, this array descriptor manipulation draws from memory pools and it is certainly possible to exhaust the pool if you do it enough. If so, you will certainly get SOME kind of error, though which one you see depends on which pool is the culprit. Again, the MS black box hides some of these details from us.

Give us a better verbal description of what you are trying to achieve. We might be able to offer a method based on a sub-query to do what you wanted to do.

 

[arnelgp]

you can do the Gap checking using Query.
if your code is not Optimized, and you are not Releasing the variables, surely error will come.

 

[The_Doc_Man]

I've got to agree with @arnelgp - but depending on exactly what you are doing, it might not matter that you release the variables. If you are taking things out of the program HEAP area and don't release them in the right order, you will fragment the heap and thus cause uncontrolled growth.

If you run the Windows Task Manager just before you run your app, and if you select Performance and then the Memory option, you would be able to see which part of memory is dropping and which one hits zero when your error occurs.

 

[A3Kluth]

Here is the code I am using. Just trying to check for gaps between the Effective date of the 1st record and the End date of the second record. The records are ordered by effective date descending. I have to load and unload the arrays every time I see a new unique order ID. Some of the order ID's can have as many as 75 or so records, that's why it's set to (90):

Option Compare Database
Public strFileName     As String
Public strNewFileName  As String
Public strDataSource   As String
Public strConnection   As String
Public strSQLStatement As String
Public StrReportName   As String
Public StrQryName      As String

Public iCount          As Integer

Public CurrentGroupNum As String
Public CurrentSection As String

Public bGroupNumSame    As Boolean
'Public bSectionSame     As Boolean
Public bSame            As Boolean

Dim DtEffDate(90)   As Date
Dim DtEndDate(90)   As Date
Dim Premium(90)    As Currency
Dim TransRowID(90)     As Long

Dim DeterminedOED As Date
Dim DeterminedRowID As Long
Dim DeterminedCovEffDate As Date

Dim strGroupNum(90) As String
'Dim strSection(90) As String


'Public iCount           As Integer
Dim i                   As Integer





Public DB              As Database
'public rst              As Recordset
Public MyForm          As Form
Option Explicit


Public Function A_CheckAllTrans()

Dim SFilename   As String
Dim BFound      As Boolean
Dim StrMemberID         As String
Dim SFullSSN    As String
Dim StrSQL      As String
Dim StrSQL1      As String
Dim SProdName   As String
Dim SChannel    As String

'Dim cn            As ADODB.Connection
Dim rst        As Recordset
Dim rst1        As Recordset
Dim rst2        As Recordset
Dim rst3        As Recordset
Dim ISSNLength    As Integer
Dim IDiff         As Long

Dim RC As Integer
Dim RowID As Integer

Dim StrReason As String
Dim StrReason1 As String
Dim IZeros As Integer
Dim RecCount As Long
Dim CL As Integer


Set DB = CurrentDb()
DAO.DBEngine.SetOption dbMaxLocksPerFile, 1000000
Set rst = DB.OpenRecordset("select * from UniqueRecs where fixed = 0")'selects unique member ID where the record hasn't been updated
If rst.EOF Or rst.BOF Then '1
    rst.Close
    MsgBox " There were no records found in the UniqueRecs Table. Check to be sure you did it correctly."
    Exit Function
Else
    RecCount = 1
    rst.MoveFirst
        Do Until rst.EOF
            StrMemberID = rst("member_ID")
            'StrMemberID = "804276499"
                    
          
            Set rst1 = DB.OpenRecordset("SELECT * from trans where fixed = 0 and member_ID = '" & StrMemberID & "'ORDER BY trans.Membership_Effective_Date DESC")
            
                If rst1.EOF Or rst1.BOF Then '2
                    rst1.Close
                    'MsgBox " There were no records found in the trans Table. Check to be sure you did it correctly."
                    'Exit Function
                Else
                    RC = DCount("[Member_ID]", "trans", "Member_ID = '" & StrMemberID & "'")
                    rst1.MoveFirst
                    RowID = 1
                    'sets array values here
                    Do Until rst1.EOF
                        DtEffDate(RowID) = rst1("membership_effective_date")
                        DtEndDate(RowID) = rst1("membership_end_date")
                        If Not IsNull(rst1("group_number")) Then
                            strGroupNum(RowID) = rst1("group_number")
                        Else
                            strGroupNum(RowID) = "11111" 'in case of a null value
                        End If
                        'strSection(RowID) = rst1("section_number")
                        TransRowID(RowID) = rst1("-RowNum-")
                        'Premium(RowID) = rst1("tot_prem")
                        'check values here
                        rst1.MoveNext
                        RowID = RowID + 1
                    Loop
                    'RowID = 1
                    i = 1
                    BFound = False
                    rst1.MoveFirst
                    RowID = 1
                    RecCount = 0
                    If RC = 1 Then 'if there is only 1 record do the rst1 assignment here
                        StrReason = "1 Record"
                        DeterminedOED = DtEffDate(i)
                        rst1("DeterminedOED") = DeterminedOED
                        rst1("reason") = StrReason
                        rst1("fixed") = True
                        rst1.Update
                        'DeterminedCovEffDate = DtEffDate(i)
                        'UpdateTrans DeterminedOED, i
                        
                    Else'if more than 1 then do the rst1 assignment here by comparing records
                        For i = i To RC
                            IDiff = DateDiff("d", DtEndDate(i + 1), DtEffDate(i))
'
                            If IDiff > 0 Then '4
                                RecCount = RecCount + 1
                                If DtEndDate(i + 1) = "12:00:00 AM" Then 'checks for no record
                                    DeterminedOED = DtEffDate(i)
                                    StrReason = "No Gap"
                                    'CoverageEffDate i
                                Else
                                    DeterminedOED = DtEffDate(i)
                                    StrReason = "Gap"
                                    If i = 1 Then
                                        DeterminedCovEffDate = DtEffDate(i)
                                        CurrentGroupNum = strGroupNum(i)
                                        'CurrentSection = strSection(i)
                                    Else
                                        'CoverageEffDate i
                                    End If
                                End If
                                '***************************
                                Set rst2 = DB.OpenRecordset("SELECT * from trans where fixed = 0 and Membership_Effective_Date >= #" & DeterminedOED & "# and member_ID = '" & StrMemberID & "' ORDER BY trans.Membership_Effective_Date DESC")
                                rst2.MoveFirst
                                Do Until rst2.EOF
                                    rst2.Edit
                                    rst2("DeterminedOED") = DeterminedOED
                                    'rst2("DeterminedCovEffDate") = DeterminedCovEffDate
                                    rst2("reason") = StrReason
                                    rst2("fixed") = True
                                    rst2.Update
                                    rst2.MoveNext
                                Loop
                                rst2.Close
'
                                rst.Edit
                                rst("fixed") = True
                                rst.Update
                               'update records
                            Else
                                RecCount = RecCount + 1
                            End If '4
                            rst1.MoveNext
                            RowID = RowID + 1
                        Next i
                    End If '5
                End If '2
            
            StrReason = " "
            StrReason1 = " "
            DeterminedOED = Empty
            DeterminedRowID = Empty
            DeterminedCovEffDate = Empty
            CurrentGroupNum = Empty
            'CurrentSection = Empty
            Erase strGroupNum
            'Erase strSection
            Erase DtEffDate
            Erase DtEndDate
            Erase Premium
            Erase TransRowID
                    
            RowID = 0
            RecCount = 0
            rst.MoveNext
        Loop
        rst1.Close
End If ' 1
rst.Close
Exit Function
End Function

 

[The_Doc_Man]

Those string arrays are killing you. A string is implemented as a descriptor taken from the program heap. Variable-length content such as a string will cause heap fragmentation which means that it a consumable - and consumed - resource.

Here is a thread (available from the Similar Threads at the bottom of the page) that is specific to a "Resources Exceeded" case.

System Resource Exceeded

Bit of a strange one... I've been building a few databases this week, none of which are overly complex. They all happily run on my i5 8GB laptop, but having moved them to run on an i7 16GB, I now get a 'System Resource Exceeded' message each time they run.

www.access-programmers.co.uk