Macro balloons mdb past 2G

[mohobrien]

Somewhat of a problem:
I have a mdb containing a number of tables, queries etc. The total size is about 40 Meg. when compacted. One of the tables is reasonably large. Only two fields, both text but only 12 in size however 400 thousand rows. Open/close/query etc no problem. About 20% bloat after half an hour of running queries on queries etc. None of this is a problem. I run one macro on this table to create one extra field (type Long) and run through the table once adding the data to that field and the mdb balloons to 1.85 Gig. I then have to compact which takes 1/2 hour. If I get many more records it will bum out and be corrupted as soon as I pass the two Gig mark.

I run the macro from the vba code window. I can't see any variables I've forgotten to clear. Below is the code I'm using. If someone can spot a goof please help

Option Compare Database
Option Explicit

Public Sub SplitPPID()

Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim rs As DAO.Recordset
Dim strSQL As String
Dim qdf As DAO.QueryDef
Dim PPIDVal As String
Dim PPIDOldVal As String
Dim Counter As Long
Dim FieldExists As Boolean

Set db = CurrentDb()
Set tdf = db.TableDefs("tbltmpNewPotashLands")
For Each fld In tdf.Fields
If fld.Name = "Counter" Then
FieldExists = True
Exit For
End If
Next
If FieldExists Then
db.Close
Else
tdf.Fields.Append tdf.CreateField("Counter", dbLong, 12)
db.Close
End If

Set db = DBEngine(0)(0)
strSQL = "SELECT PPID, Counter FROM tbltmpNewPotashLands;"
    Set rs = db.OpenRecordset(strSQL)
    PPIDOldVal = ""
    Do While Not rs.EOF
        PPIDVal = rs!PPID
        If PPIDVal <> PPIDOldVal Then
        Counter = 1
        PPIDOldVal = PPIDVal
        Else
        Counter = Counter + 1
        PPIDOldVal = PPIDVal
        End If
   With rs
      .Edit
      rs!Counter = Counter
       .Update
   End With
       Debug.Print rs!PPID
        rs.MoveNext
    Loop
    rs.Close
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
End Sub


Function FieldExists() As Boolean
Dim db As DAO.Database
Dim As TableDef
Dim fld As Field
Dim strName As String
Set db = CurrentDb
Set tbl = db.TableDefs("tbltmpNewPotashLands")
strName = "Counter"
End Function
]

 

[RuralGuy]

I do not see the value of the FieldExists() function and It is not retirning a Boolean value.

 

[RuralGuy]

Adding fields to a table requires a great deal of space in the mdb. How about copying the table to a fresh mdb and add the field and initialize in that external mdb while you are linked to it? Then delete the existing table and copy the table from the temporary mdb and then just delete the temp mdb.

 

[mohobrien]

I'll give that approach a try. The Fieldexists was a start at automating the whole process to do everything I'm doing in code but I messed it up and can't be bothered fixing it until I resolve the more urgent issue.