MS Access database grow issue

Question

I have created below piece of code in order to amend some data in an Access table:

Dim Ways As DAO.Recordset
Dim Keys As DAO.Recordset
Dim Recordcount As Double
Dim Records As Double
Dim ID_Old As String
Dim ID_New As String
Dim STArray() As String
Dim SaveTime As String

Set Ways = CurrentDb.OpenRecordset("Ways_Sorted")

Recordcount = 1
Records = 3724755


Ways.MoveFirst

Dim word As Variant

    While Not Ways.EOF
    DoCmd.SetWarnings (False)
        DoCmd.OpenQuery "KeyFind:DEL"
    DoCmd.SetWarnings (True)

     Set Keys = CurrentDb.OpenRecordset("KeyFind")

        STArray = Split(Ways!Veld4, ";")
        For Each word In STArray
            If Len(word) > 0 Then
                Keys.AddNew
                Keys!IDOld = CDbl(word)
                Keys!IDNew = DLookup("[New ID]", "ID Keys", "[Old ID]=" & CDbl(word))
                Keys.Update
            End If
        Next

        Keys.MoveFirst
        While Not Keys.EOF
        ID_Old = " " + Trim(Str$(Keys!IDOld))
        ID_New = " " + Trim(Str$(Keys!IDNew))
            Ways.Edit
            Ways!Veld4 = Replace(Ways!Veld4, ID_Old, ID_New)
            Keys.MoveNext
        Wend
        Keys.Close

        Me.Tekst1 = Recordcount
        Me.Tekst3 = Records - Recordcount
        Me.Tekst5 = FileLen(Application.CurrentProject.Path & "\Map_Convert_2.mdb")
        If FileLen(Application.CurrentProject.Path & "\Map_Convert_2.mdb") > 1977142784 Then
                '            Exit Sub
        End If

        DoEvents
        Ways!Done = True
        Ways.Update
        Ways.MoveNext
        Recordcount = Recordcount + 1
        'CommandBars("Menu Bar").Controls("Tools").Controls("Database utilities").Controls("Compact and repair database...").accDoDefaultAction
        'Stop
    Wend

DoCmd.SetWarnings (False)
    DoCmd.OpenQuery "Ways_Amend ID"
DoCmd.SetWarnings (True)

MsgBox "New Map created"

Actually what the code is doing is replacing the data in field "Veld4" in table "Ways_Sorted". This field holds a string with ID's, which is splitted with STArray = Split(Ways!Veld4, ";") into an array. This array is stored in a table called "KeysFound". Another table in my database is containing the old ID and the new ID. As said the rest of the code will replace the old id in "Veld4"with the new ID. It is looping through 3.7 million records this way.

My problem is that after 250 loops or so my database has grown with 1mB, meaning that my database will be above the 2gB way before the code has finished.

I can not explain why the growth is happening and how I can stop this or at leas reduce the growth

Answer 1

Your code has lots of potential for optimization.

Main issue: you are constantly writing into and deleting from the Keys table. I guess this is also the cause of the growth issue.

This table is unnecessary. Just do the replacement right after reading each key. Build the new Veld4 as string NewVeld, only write it into the table once you are finished for the current Ways row.

    STArray = Split(Ways!Veld4, ";")
    NewVeld = ""
    For Each word In STArray
        If Len(word) > 0 Then
            NewKey = DLookup("[New ID]", "ID Keys", "[Old ID]=" & CDbl(word))
            ' you will have to adapt this to your exact "veld" structure
            ' If there is a specific reason, you can also continue to use Replace(),
            ' but I don't think it's necessary.
            NewVeld = NewVeld & ";" & NewKey
        End If
    Next
    ' remove leading ";"
    NewVeld = Mid(NewVeld, 2)

    Ways.Edit
    Ways!Veld4 = NewVeld
    Ways!Done = True
    Ways.Update
    Ways.MoveNext

Further optimization: DLookup is a rather expensive operation for your row count.
Consider loading the whole ID Keys table into a Dictionary object at the beginning, then reading the new IDs from there.