Edit/Update results in badly fragmented file

[esteiner]

I am scrubbing values of a field in an Access table and updating the results in the same table.

The routine runs OK but the size of the database goes to 600+ MB. I must run the compact and repair database operation each time I run the routine. The amount of data to process will continue to increase, so I would like to make this routine as efficient as possible.

I assume that this is caused by the many read/write cycles to the hard disk. Is there a way to store a temp table into RAM before writing to disk? Any help/suggestions to make this more efficient would be appreciated :help . Below is the code that runs the routine:

Private Sub cmdSplitMPN_Click()
On Error GoTo E_Handle
Dim rs As Recordset ' Recordset object
Dim strTableName As String ' Name of table where export records originate
Dim strSQL As String ' SQL String
Dim intRecordNum As Long ' Record Number being dealt with
Dim strMPN As String
Dim I As Integer
Dim strPrefix As String
Dim strBasenum As String
Dim blHasNum As Boolean
Set db = DBEngine(0)(0)

' Create the table name from where the export records will orginate
strTableName = "pull_inv_BRE"
strQuote = Chr$(34)
strSQL = "SELECT ManfPartNum, CorePartNum FROM " & strTableName & ""
Set rs = db.OpenRecordset(strSQL)
With rs
While Not (.BOF Or .EOF)
strMPN = !ManfPartNum
For I = 1 To Len(strMPN)
blHasNum = False
If IsNumeric(Mid(strMPN, I, 1)) Then
'number found, exit
blHasNum = True
Exit For
End If
Next I

If (blHasNum = True) Then
strBasenum = Right(strMPN, Len(strMPN) - I + 1)
.Edit
!CorePartNum = strBasenum
.Update
End If
.MoveNext
Wend
.Close
End With

sExit:
On Error Resume Next
rs.Close
Set rs = Nothing
Set db = Nothing
Reset
Exit Sub
E_Handle:
MsgBox Err.Description, vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit

End Sub

Thank you for your help!!!

-Charlie

[OBP]

Charlie, I don't know why it is bloating the database so much, but you might be able to improve your code.
You could include this part

strBasenum = Right(strMPN, Len(strMPN) - I + 1)
.Edit
!CorePartNum = strBasenum
.Update

in to the previous If/Then because this
If IsNumeric(Mid(strMPN, I, 1)) Then
'number found, exit
blHasNum = True
Exit For
just sets blHasNum to True which you then use in the second If/Then, why not just do the
strBasenum = Right(strMPN, Len(strMPN) - I + 1)
.Edit
!CorePartNum = strBasenum
.Update

instead of setting blHasNum to True.


You could also do away with the While/Wend and replace it with a for/next by setting a variable (Integer) to rs.recordcount to find the actual number of records and use that in a for next loop.
You could also use CurrentDB instead of Set db = DBEngine(0)(0) and then using db in the db.OpenRecordset(strSQL).

[stanl]

Might be a bit kludgy using the Access LIKE to simulate SQL Servers CONTAINS clause, but have you considered writing this as an Update Query? Stan

[JimmyTheHand]

:hi:

I rewrote your code in the hope of making it better. I included some of OBP's recommendations. I don't know if it will do any better, but it just might so give it a try. I deleted some unnecessary variables, simplified the update part, etc. but the only thing I really have faith in to make a difference is opening the table directly, instead of as a query. It seems like there was once a "WHERE" clause at the end of the SQL, but now it's gone, so it goes through all records anyway.

Jimmy


Private Sub cmdSplitMPN_Click()
On Error GoTo E_Handle
Dim rs As Recordset ' Recordset object
Dim strTableName As String ' Name of table where export records originate
Dim strMPN As String
Dim I As Integer

' Create the table name from where the export records will orginate
strTableName = "pull_inv_BRE"
'Open table
Set rs = CurrentDb.OpenRecordset(strTableName)
With rs
.MoveFirst
While Not (.BOF Or .EOF)
strMPN = !ManfPartNum
For I = 1 To Len(strMPN)
If IsNumeric(Mid(strMPN, I, 1)) Then
.Edit
!CorePartNum = Mid(strMPN, I) ' gives the same result as Right(strMPN, Len(strMPN) - I + 1)
.Update
Exit For
End If
Next I
.MoveNext
Wend
.Close
End With

sExit:
On Error Resume Next
rs.Close
Set rs = Nothing
Reset
Exit Sub
E_Handle:
MsgBox Err.Description, vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub

[OBP]

Jimmy, very neat. :thumb