Edit/Update results in badly fragmented file 1

[esteiner]

I am scrubbing values of a field1 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. Below is the code that runs the routine:

Private Sub cmdCleanManfPart_Click()
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 strOutLine As String
Dim strOneChar As String
Dim strAllowed As String
Dim strNewMPN As String
Dim intCountRecords As Long ' Total number of records to be processed
Dim strMPN As String
Dim strChanged As String
Dim I As Integer
Set db = DBEngine(0)(0)

' Create the table name from where the export records will orginate
strTableName = "CATALOG"
' Get the number of records to be created (rounding up)
intCountRecords = -Int(-DCount("ManfPartNum_NP", strTableName))
strQuote = Chr$(34)
' Characters Allowed in data
strAllowed = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.()#+%,"

' Get recordset
strSQL = "SELECT ManfPartNum_NP, Changed FROM " & strTableName & ""
Set rs = db.OpenRecordset(strSQL)

For intRecordNum = 1 To intCountRecords
If Not (rs.BOF And rs.EOF) Then
strNewMPN = ""
strChanged = "NO"
strMPN = rs!ManfPartNum_NP

'---------------------------------------------------
'- Build an output string containing the valid -
'- characters from the input string -
'---------------------------------------------------

For I = 1 To Len(strMPN)
strOneChar = Mid$(strMPN, I, 1)
If InStr(strAllowed, strOneChar) > 0 Then
strNewMPN = strNewMPN & strOneChar
End If
If InStr(strAllowed, strOneChar) < 1 Then
strChanged = "YES"
End If
Next I
If Len(strNewMPN) > 0 Then
rs.Edit
rs!ManfPartNum_NP = strNewMPN
rs!Changed = strChanged
rs.Update
End If

rs.MoveNext
End If
Next intRecordNum
rs.Close

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

-Charlie

 

[PHV]

What about something like this ?

strSQL = "SELECT ManfPartNum_NP, Changed FROM " & strTableName
Set rs = db.OpenRecordset(strSQL)
With rs   
  While Not (.BOF And .EOF) Then
    strNewMPN = ""
    strMPN = !ManfPartNum_NP
    For I = 1 To Len(strMPN)
      strOneChar = Mid$(strMPN, I, 1)
      If InStr(strAllowed, strOneChar) > 0 Then
        strNewMPN = strNewMPN & strOneChar
      End If
    Next I
    If strNewMPN <> strMPN Then
      .Edit
      !ManfPartNum_NP = strNewMPN
      !Changed = "YES"
      .Update
    End If
    .MoveNext
  WEnd
  .Close
End With

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[esteiner]

Thank you,

These minor but very important changes resulted in the routine running 20x faster with virtually no fragmentation of the file.

Does the 'With rs' statement operate on the recordset that has already been loaded into RAM? Does it only write to disk once the operation is complete?

This suggestion will save me HOURS of time every week. Thank you!!!

 

[esteiner]

I have one other scrubbing routine that I run. I tried to make the same changes that were suggested above. Once this second routine is complete the file is badly fragmented(my original problem). Below is the code for this second 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


Any help would again be appreciated.

Thank you

-Charlie