strange ADO error

[klaas]

Hi,

we have had a strange error when trying to use ADO for transferring data from one database called DBcheck (without relations and primary keys) to another of identical structure called DBfinal (but with relations and primary keys). When using the code pasted below, everything works fine until we are trying to insert a record into DBfinal that lacks a corresponding entry in a hierarchically higher table. We receive an error message saying that the data could not be appended to the table because the defined relations demand that there should be a corresponding entry in another table (error number -2147217887).

We knew that these constellations would occur, thus an error handling routine copes with this situation. The problem is that once this error has been handled, the same error occurs with *each* following attempt to transfer data from DBcheck to DBfinal - even though all necessary entries in hierarchically higher tables exist. Furthermore, the recordset that we are *reading* the data from in DBcheck can no longer be closed.

If we try to insert the concerned data manually into DBfinal, everything works fine. Does anyone have any suggestion about the cause of these problems and how to solve them?
We attach the essential parts of the code (which has been tested with different ADO libraries, ranging from version 2.1 to 2.7 - all give the same problem).

We desperately need to get this code working - any help would be highly appreciated!

Klaas & Konrad



...

cnnDBcheck.ConnectionString = "Data Source=" & outputPath & "\" &
DBcheckName & ";Provider=Microsoft.Jet.OLEDB.4.0"
cnnDBfinal.ConnectionString = "Data Source=" & outputPath & "\" &
DBfinalName & ";Provider=Microsoft.Jet.OLEDB.4.0"

...

rstDBcheck.Open strTableName, cnnDBcheck, adOpenKeyset,
adLockOptimistic, adCmdTableDirect
rstDBfinal.Open strTableName, cnnDBfinal, adOpenDynamic,
adLockOptimistic, adCmdTableDirect

...

rstDBcheck.MoveFirst
Do Until rstDBcheck.EOF
If rstDBcheck!CompCode <> 3 Then
varTMP = rstDBcheck.GetRows(1, Fields:=arrFields) 'Copying
Current Record to an array, get rows does a move next
arrRecord = rearangeArray(varTMP) ' convert an 2D Array with
one line to an 1D array
rstDBfinal.AddNew arrFields, arrRecord ' !!! the error occurs after this statement !!!
rstDBfinal.Update
Else
rstDBcheck.MoveNext
End If
Loop

...

 

[Alexandre]

If relational integrity was enforced in your DBcheck , you should have no unmatched records one the many side of a relationship, so I do not really understand how you come to get this error.?

The only thing that comes to my mind is that you should always begin to populate top-hierarchy (the one side of relationships) tables first, then progressively descendi the hierarchy, but I may be stating the obvious?

 

[klaas]

Hi ALexandre,

DBcheck does not have any relations at all and thus does not assume relational integrity (it is the purified version of a corrupt DB and we try to save all remaining data by transferring them algorithmically to DBfinal).

As for your 2nd suggestion, we do indeed follow a top-down order, i.e. transfer data to the hierarchically highest table first and then proceed down the relational hierarchy.

Cheers,
Klaas

 

[Alexandre]

Could you show how you handle the error?

 

[klaas]

Currently, we simply use an "On Error" statement and print error number and error description using the Err object. The identical error message is displayed by Access if we omit any error handling routine, so I don't think that we are simply being fooled by our error handling routine.

Klaas

 

[Alexandre]

I maybe wrong but at the moment I do suspect your error handling to be in cause. I put up a simple trial DB, populating records on the many side of a relationship from records belonging to another table of the same DB. Of course, these are not the same conditions as yours, but I introduced purposedly orphan records to see how to handle the error. It works just fine, printing to the immediate window orphan records and skipping them.

Public Sub Trial()
Dim rstDBcheck As Recordset
Dim rstDBfinal As Recordset

On Error GoTo Err_Trial

Set rstDBcheck = DBEngine(0)(0).OpenRecordset("Tabela1", dbOpenTable)
Set rstDBfinal = DBEngine(0)(0).OpenRecordset("TblCalculation", dbOpenTable)

With rstDBcheck
   .MoveFirst
   Do While Not .EOF
      rstDBfinal.AddNew
      rstDBfinal!MainID = !ID
      rstDBfinal!Name = !Name
      rstDBfinal.Update
Skip_Trial:
      .MoveNext
   Loop
End With

Trial_exit:
rstDBcheck.Close
rstDBfinal.Close
Exit Sub

Err_Trial:
Debug.Print Err.Number & ": " & Err.Description
Select Case Err
Case 3201
    Debug.Print rstDBcheck!ID & ": " & rstDBcheck!Name
    rstDBfinal.CancelUpdate
    If rstDBfinal.EditMode = dbEditAdd Then rstDBfinal.Delete
    Resume Skip_Trial
Case Else
    GoTo Trial_exit
End Select

End Sub