Here is one that is stumping me.
I have an Access 2000 database backend. It got corrupted. It is a large database. I compacted and repaired it and a record came up corrupted. There was a compact error table created that has a binary column in it. The binary column points to a bookmark that tells which row was corrupted. I am trying use vb .net to retrieve that row using the binary column to show me which record is corrupted, however, I cannot get it to work right. I have found VBA for Access code that does something similar, but I need it in VB .net. Here is the VBA code that I have:
Sub main()
On Error GoTo ErrorHandler
Dim db As DAO.Database, vBookMark As Variant, _
rsMSysCompactError As DAO.Recordset, strErrorTable As String, _
rsErrorTable As DAO.Recordset, fldErrorField As DAO.Field, _
strSQLSEL As String, strColumnValue As Variant, _
qdTemp As QueryDef, strSQLINS As String, intLoop As Integer, _
lngTableNameLength As Long, _
colErrorCollection As New Collection, intErrorCount As Integer
Set db = CurrentDb()
' Walk through the MSysCompactError table to find rows that reflect
' lost data values.
Set rsMSysCompactError = db.OpenRecordset("SELECT * FROM MSysCompactError WHERE ErrorRecId IS NOT NULL", dbOpenDynaset)
intErrorCount = 0
While Not rsMSysCompactError.EOF
' Get the name of the table that had column data missing.
strErrorTable = rsMSysCompactError!ErrorTable
' Check to see that tablename is not greater than 48 characters
' to stay under 64 character tablename limit.
lngTableNameLength = Len(strErrorTable)
If lngTableNameLength > 48 Then
strErrorTable = Mid(strErrorTable, 1, 48)
' See if this truncated table name already exists.
On Error Resume Next
colErrorCollection.Add strErrorTable, strErrorTable
' If this already exists in the collection, then there is a
' duplicate table name.
If Err = 457 Then
' Truncate one more digit to append on the intErrorCount
' number to eliminate the duplicate table name.
strErrorTable = Mid(strErrorTable, 1, 47)
strErrorTable = strErrorTable & Mid((Str(intErrorCount)), 2, 1)
intErrorCount = (intErrorCount + 1)
End If
End If
' Get the bookmark value of the row that had lost column data.
vBookMark = rsMSysCompactError!ErrorRecId
' Open table that has lost column data.
Set rsErrorTable = db.OpenRecordset(strErrorTable, dbOpenTable, dbReadOnly)
' Move to row that has lost column data.
rsErrorTable.Bookmark = vBookMark
' Start to build SQL string to call up in a table window.
strSQLSEL = "SELECT * INTO MSysCompactError" & strErrorTable & " FROM " & strErrorTable & " WHERE "
strSQLINS = "INSERT INTO MSysCompactError" & strErrorTable & " SELECT * FROM " & strErrorTable & " WHERE "
intLoop = 0
For Each fldErrorField In rsErrorTable.Fields
strColumnValue = fldErrorField.Value
' Logic to build predicate based on various data types.
If Not IsNull(strColumnValue) Then
' Can't use ordinal as no guarantee of first column
' being zero.
' Check to see if this is the first column or not to
' build SQL statement.
If intLoop = 0 Then
If fldErrorField.Type = dbDate Then
strSQLSEL = strSQLSEL & "[" & fldErrorField.Name & "] = " & "#" & strColumnValue & "#"
strSQLINS = strSQLINS & "[" & fldErrorField.Name & "] = " & "#" & strColumnValue & "#"
Else
If fldErrorField.Type = dbText Or fldErrorField.Type = dbChar Or fldErrorField.Type = dbMemo Then
strSQLSEL = strSQLSEL & "[" & fldErrorField.Name & "] = " & "'" & strColumnValue & "'"
strSQLINS = strSQLINS & "[" & fldErrorField.Name & "] = " & "'" & strColumnValue & "'"
Else
strSQLSEL = strSQLSEL & "[" & fldErrorField.Name & "] = " & strColumnValue
strSQLINS = strSQLINS & "[" & fldErrorField.Name & "] = " & strColumnValue
End If
End If
Else
If fldErrorField.Type = dbDate Then
strSQLSEL = strSQLSEL & " AND " & "[" & fldErrorField.Name & "] = " & "#" & strColumnValue & "#"
strSQLINS = strSQLINS & " AND " & "[" & fldErrorField.Name & "] = " & "#" & strColumnValue & "#"
Else
If fldErrorField.Type = dbText Or fldErrorField.Type = dbChar Or fldErrorField.Type = dbMemo Then
strSQLSEL = strSQLSEL & " AND " & "[" & fldErrorField.Name & "] = " & "'" & strColumnValue & "'"
strSQLINS = strSQLINS & " AND " & "[" & fldErrorField.Name & "] = " & "'" & strColumnValue & "'"
Else
strSQLSEL = strSQLSEL & " AND " & "[" & fldErrorField.Name & "] = " & strColumnValue
strSQLINS = strSQLINS & " AND " & "[" & fldErrorField.Name & "] = " & strColumnValue
End If
End If
End If
End If
intLoop = (intLoop + 1)
' QJet limitation for maximum conditions is reached.
If intLoop = 39 Then
Exit For
End If
Next fldErrorField
On Error Resume Next
' Create error table if it does not exist.
db.Execute strSQLSEL, dbFailOnError
If Err = 3010 Then
On Error GoTo ErrorHandler
' Add rows to error table if it already exists.
db.Execute strSQLINS, dbFailOnError
End If
rsErrorTable.Close
rsMSysCompactError.MoveNext
Wend
rsMSysCompactError.Close
MsgBox "Done!"
Exit Sub
ErrorHandler:
MsgBox "An error has occurred " & Err & " " & Error
Resume Next
End Sub
Any ideas?
Thanks, Chester