VBA subroutine to recover records from a table with multiple corrupt records.

Recover Access Table Records - VBA

Public Sub RecoverRecords()

On Error GoTo errHandler

'Example Code - Generic variable and field names have been used throughout.

Dim rstOld As DAO.Recordset   'Recordset to hold records from corrupt table.
Dim sqlComplete As Boolean
Dim counter As Long

'Open recordset of original table.  Set record counter to 0.
Set rstOld = CurrentDb.OpenRecordset("SELECT PrimaryKey FROM CorruptTable")
counter = 0

'Turn off SQL confirmations
DoCmd.SetWarnings False

'Iterate through the records and run an INSERT query for each one using the primary
' key field to select the record.

Do While Not rstOld.EOF
    sqlComplete = False
    DoCmd.RunSQL "INSERT INTO NewTable SELECT CorruptTable.* FROM CorruptTable WHERE
       (((CorruptTable.PrimaryKey) = """ &  rstOld![PrimaryKey] & """));"


    'Verify the record has been inserted and return a True / False value
    'based on the count of the record.
    sqlComplete = (DCount("[NewTable]![PrimaryKey]", "NewTable", 
        "[NewTable]![PrimaryKey] = """ & rstOld![PrimaryKey] 
        & """") > 0)

    'If the verification failed, notify in the console ...
    If Not sqlComplete Then
        Debug.Print rstOld![PrimaryKey] & " failed to copy."
    End If

NextRec:
    'Move to the next record and update the count every 500 records to show progress.
    counter = counter + 1
    If counter Mod 500 = 0 Then Debug.Print counter & " records copied."
    DoEvents  'Allow Access to continue responding to input.
    rstOld.MoveNext
Loop

Cleanup:
    'Dump the recordset and tun notifications back on.
    Set rstOld = Nothing
    DoCmd.SetWarnings True

Exit Sub

errHandler:

'Print the error to the console and try the next record.
Debug.Print "Error copying """ & rstOld![PrimaryKey]
Resume NextRec

End Sub