Excessive File Growth

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi All,

I wrote some code to assign a claim number and calculate a check digit, mod,
and barcode. I am running this on a million records and the file size starts
a 257 megs. The code crashes about half way through because the file size
grows to over 2 gigs. When I import the same table into a new mdb and
compact, it is 274 megs.

The code seems very unremarkable. I link a table from another file then loop
through the target table doing some calcs with a few more interior loops.
Nothing is going on that should lead to that kind of size increase.

Any thoughts on what could cause this and work arounds to get this working
would be much appreciated.

Thanks,

alr
 
Hi All,

I wrote some code to assign a claim number and calculate a check digit, mod,
and barcode. I am running this on a million records and the file size starts
a 257 megs. The code crashes about half way through because the file size
grows to over 2 gigs. When I import the same table into a new mdb and
compact, it is 274 megs.

The code seems very unremarkable. I link a table from another file then loop
through the target table doing some calcs with a few more interior loops.
Nothing is going on that should lead to that kind of size increase.

Any thoughts on what could cause this and work arounds to get this working
would be much appreciated.

If you're updating records one at a time in your loop, this would not
be unexpected: Access will treat each record as its own transaction
(unless you define a transaction yourself of course), and basically
rewrite the table to disk at every iteration.

Better might be to run a single Append query into a new table (perhaps
in a separate backend database - even 257 MByte is getting pretty
large!). Perhaps you could post your code if you need specific advice.

John W. Vinson[MVP]
Join the online Access Chats
Tuesday 11am EDT - Thursday 3:30pm EDT
http://community.compuserve.com/msdevapps
 
The following code is still in the test phase but it works other than the
file growth issue.

An associate mentioned that there was a way to modify update queries to not
do a delete prior to updates but I could not find any information about this.

Thanks for looking into this issue,

alr


Option Compare Database
Option Explicit

Public Function ProdBrCd()
On Error GoTo errHdl1

Debug.Print "Start " & Now()

Dim I As Long
Dim J As Long
Dim intClmSum As Long
Dim intClmNbr As Long
Dim intCheckDigit As Long
Dim MaxOfClaim7 As Long
Dim ModSum As Long
Dim TmpDig As Long
Dim CurChar As String
Dim ClmPlCkDig As String
Dim CaseCode As String
Dim ApndSql As String
Dim MstrTbl As String
Dim strMastPth As String
Dim strOpMast As String
Dim strErrTrck As String

strErrTrck = "Opening"

CaseCode = Forms!AddClm7BCode!txtCaseCode
CaseCode = UCase(CaseCode)

MstrTbl = CaseCode & "Master"

strMastPth = "c:\BrCD\" & CaseCode & "master" & ".mdb"

DoCmd.TransferDatabase acLink, "Microsoft Access", strMastPth, acTable,
CaseCode & "Master", CaseCode & "Master"

Dim rsWkDt As Recordset
Set rsWkDt = New Recordset
rsWkDt.Open "select * from WkDt", CurrentProject.Connection, adOpenDynamic,
adLockOptimistic

Dim rsMaster As Recordset
Set rsMaster = New Recordset
strOpMast = "Select * from " & MstrTbl & ""
'MsgBox strOpMast
rsMaster.Open strOpMast, CurrentProject.Connection, adOpenDynamic,
adLockOptimistic


MaxOfClaim7 = DMax("[claim7]", MstrTbl)
'MaxOfClaim7 = "SELECT Max(ABC1MASTER![CLAIM7]) AS MaxOfCLAIM7 FROM
ABC1MASTER;"

strErrTrck = "start1stloop"

rsWkDt.MoveFirst
J = 1

Do Until rsWkDt.EOF

strErrTrck = "in1stloop"

'If AutoAdd not = record count error out, automate added field??

'populate claim number
rsWkDt![claim7] = MaxOfClaim7 + J

If rsWkDt![claim7] = 1071489 Then
MsgBox ("under coming up")
End If

intClmSum = 0
I = 0

Do Until I = Len(rsWkDt![claim7])
strErrTrck = "in2ndloop"

'Calc Check Digit Sum
intClmSum = intClmSum + Mid(rsWkDt![claim7], Len(rsWkDt![claim7]) -
I, 1) * (I + 2)

I = I + 1

Loop

'Create Check Digit
intCheckDigit = intClmSum Mod 11
intCheckDigit = 11 - intCheckDigit

If intCheckDigit = 10 Or intCheckDigit = 11 Then
intCheckDigit = 0
End If

'Assign CkDig
rsWkDt![CkDig] = intCheckDigit

'Calculate Mod to Claim7 PLUS CkDig
ClmPlCkDig = rsWkDt![claim7] & intCheckDigit

I = 0
ModSum = 0

Do Until I = Len(ClmPlCkDig)

strErrTrck = "in3rdloop"

'Calc Mod Sum
CurChar = Mid(ClmPlCkDig, Len(ClmPlCkDig) - I, 1)
CurChar = UCase(CurChar)

'Convert Curr MOD Char to Ascii in case there are alpha chars
If Asc(CurChar) > 47 And Asc(CurChar) < 58 Then
ModSum = ModSum + Asc(CurChar) - 48
End If
If Asc(CurChar) > 64 And Asc(CurChar) < 91 Then
ModSum = ModSum + Asc(CurChar) - 55
End If
If Asc(CurChar) = 45 Then
ModSum = ModSum + Asc(CurChar) + 36
End If
If Asc(CurChar) = 46 Then
ModSum = ModSum + Asc(CurChar) + 37
End If
If Asc(CurChar) = 32 Then
ModSum = ModSum + Asc(CurChar) + 38
End If
If Asc(CurChar) = 36 Then
ModSum = ModSum + Asc(CurChar) + 39
End If
If Asc(CurChar) = 47 Then
ModSum = ModSum + Asc(CurChar) + 40
End If
If Asc(CurChar) = 43 Then
ModSum = ModSum + Asc(CurChar) + 41
End If
If Asc(CurChar) = 37 Then
ModSum = ModSum + Asc(CurChar) + 42
End If


'ModSum = ModSum + Mid(rsWkDt![claim7], Len(rsWkDt![claim7]) - I, 1)

I = I + 1

Loop

strErrTrck = "fin3rdloop"

'Create Check Digit converting ascii back to chr()
TmpDig = ModSum Mod 43

If (TmpDig >= 0) And (TmpDig <= 9) Then
TmpDig = TmpDig + 48
End If
If (TmpDig >= 10) And (TmpDig <= 35) Then
TmpDig = TmpDig + 55
End If
If TmpDig = 36 Then
TmpDig = 45
End If
If TmpDig = 37 Then
TmpDig = 46
End If
If TmpDig = 38 Then
TmpDig = 175 'OverScore instead of space or underscore, no scan
End If
If TmpDig = 39 Then
TmpDig = 36
End If
If TmpDig = 40 Then
TmpDig = 47
End If
If TmpDig = 41 Then
TmpDig = 43
End If
If TmpDig = 42 Then
TmpDig = 37
End If

strErrTrck = "fin3rdloopAftIfs"
rsWkDt![Mod] = Chr(TmpDig)
rsWkDt![BarCode] = "*" & CaseCode & rsWkDt![claim7] & rsWkDt![CkDig] &
rsWkDt![Mod] & "*"
rsWkDt.Update

rsWkDt.MoveNext
J = J + 1

Loop

strErrTrck = "afterloops"

'ApndSql = "INSERT INTO " & CaseCode & "MASTER SELECT WkDt.* FROM WkDt;"
'DoCmd.RunSQL ApndSql

Debug.Print "End " & Now()

Set rsWkDt = Nothing
Set rsMaster = Nothing

ExitErrHdl1:
Exit Function
errHdl1:
MsgBox Err.Description & " " & strErrTrck
Resume ExitErrHdl1

End Function
 
alr,

I don't know if you found your answer but I happen to come across this same
problem today and it has been driving me nuts. I saw you code in one of the
later post and looked very similiar to what I was trying to do. I was
reading the Access 2000 Dev Handbook and it gave me an idea.

I changed my lock type on my recordset from adLockOptimistic to
adLockPessimistic. But there is a catch. In order to use adLockPessimistic
you have to create a new connection object for the access connection. For
example you currently have:

rsWkDt.Open "select * from WkDt", CurrentProject.Connection, adOpenDynamic,
adLockOptimistic

Try this:

dim cnn as new adodb.connection

cnn.open currentproject.baseconnectionstring

rsWkDt.Open "select * from WkDt", cnn, adOpenKeyset, adLockPessimistic

.....

My process just completed using this method an my mdb file barely grew.

Hope this helps,
Brian
 
Back
Top