1
votes

My problem is, with each iteration of an update loop, I lose about 100k of memory, so eventually, I get an out of resource error after a few thousand iterations.

The question is, why am I losing memory?

Below is a code fragment which is a loop updating data.

The criteria is extracted from a local database, dao.recordset method. -- rs1

The comparison comes from the target database where the update will be done, dao.recordset method. -- rs2 is the target read to see if I need to do an update

The update is a Docmd.Runsql query into a linked sharepoint table. And yes, I know I could use .edit and .update but in that case other strange things happen for a different post. :)

Access 2010 into Sharepoint 2010

Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset

Set db = CurrentDb
Set rs1 = db.OpenRecordset("datefix")

Do While Not rs1.EOF
    Set rs2 = db.OpenRecordset("select `Required delivery` from xyzzy where `SO Line` = '" & rs1.Fields(0).Value & "'")
    If rs1.Fields(1).Value = rs2.Fields("Required delivery") Then
    Else
        DoCmd.RunSQL "update ProblemTracking set `Required delivery` = '" & rs1.Fields(1).Value & "', `1st GI Dat` = '" & rs1.Fields(2).Value & "' where `SO Line` = '" & rs1.Fields(0).Value & "'"
    End If
    rs2.Close
    Set rs2 = Nothing

    rs1.MoveNext
Loop
1
Yes I'm watching the MSACCESS.EXE memory size grow with each iteration. The close is later, The memory appears to grow at 100k per iteration. - user3666385
Try using currentdb.Execute. The docmd is wrapped in a transaction, and that "could" be the reason why memory not being released. - Albert D. Kallal

1 Answers

0
votes

Consider converting your VBA recordsets into one stored action query. You see in SQL, JOIN is considered an explicit join and WHERE is considered an implicit join. Optimizers run these two equivalently. And update queries can use join statements. Moreover, stored queries in contrast to VBA queries are analyzed, optimized, and cached by the database with the optimal execution plan stored internally.

If I read your code correctly, you have three tables: datefix, xyzzy, and ProblemTracking all joined by SO Line (and whatever the corresponding column in dateFix as your example uses field numbers and not names). Basically, you need to update the [Required delivery] and [1st GI Dat] fields in ProblemTracking whenever the corresponding second column of dateFix does not equal [Required delivery] in xyzzy.

Hence, consider saving the below Update Query as its own object and running it in VBA with DoCmd.OpenQuery:

UPDATE (ProblemTracking 
INNER JOIN datefix ON ProblemTracking.`SO Line` = datefix.`FirstColumn`)
INNER JOIN xyzzy ON xyzzy.`SO Line` = datefix.`FirstColumn`
  SET `Required delivery` = datefix.`SecondColumn`, `1st GI Dat` = datefix.`ThirdColumn` 
WHERE datefix.SecondColumn <> xyzzy.`Required delivery` 

Now if the above is not an updatedatable query, use a DLookUp():

UPDATE ProblemTracking 
INNER JOIN datefix
ON ProblemTracking.`SO Line` = datefix.`FirstColumn`
WHERE datefix.SecondColumn <> 
      DLookUp("[Required delivery]", "xyzzy", "[SO Line]='" & datefix.FirstColumn & "'")

But if you insist on using VBA recordsets, still considering joining all three tables in a SELECT query where you only use one recordset.

Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb

' PULLING ONLY NEEDED COLUMNS IN JOIN OF THREE TABLES
strSQL = "SELECT datefix.`FirstColumn`, datefix.`SecondColumn`, datefix.`ThirdColumn`" _ 
          & " FROM (ProblemTracking" _ 
          & " INNER JOIN datefix ON ProblemTracking.`SO Line` =  datefix.`FirstColumn`)" _
          & " INNER JOIN xyzzy ON xyzzy.`SO Line` = datefix.`FirstColumn`" _
          & " WHERE datefix.SecondColumn <> xyzzy.`Required delivery`;" 

Set rs = db.OpenRecordset(strSQL)

rs.MoveLast
rs.MoveFirst

Do While Not rs.EOF
    DoCmd.RunSQL "UPDATE ProblemTracking 
                  SET `Required delivery` = '" & rs.Fields(1).Value & "', 
                      `1st GI Dat` = '" & rs.Fields(2).Value & "' 
                  WHERE `SO Line` = '" & rs.Fields(0).Value & "'"
    rs.MoveNext
Loop

rs.Close
Set rs = Nothing