ADO error when filling JET database 1

[combo]

I am creating JET database (excel VBA, ADOX) and populate tables with code (excel VBA, ADO). The code stops after writng part of the data (in the example below: i varies within 8000-12000), due to lock, error no. 80040e21. Both tables are in the same database, they are populated paralelly.
There are no problems if I use two databases or populate table by table. Is it a way to fill the tables as I planned? The code:

Sub CreateMdbDatabase()
Dim adxCat As ADOX.Catalog
Dim adxTable As ADOX.Table
Dim Conn As Variant

Dim strDB As String

strDB = "d:\test\Test.mdb"

' ADOX: database
Set adxCat = New ADOX.Catalog
adxCat.Create ("Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strDB & ";" & _
        "Jet OLEDB:Engine Type=5")
Conn = adxCat.ActiveConnection

' ADOX: tables
Set adxTable = New ADOX.Table
With adxTable
    .Name = "Table_1"
    With .Columns
        .Append "Column_1", adSmallInt
        .Append "Column_2", adUnsignedTinyInt
        .Append "Column_3", adInteger
    End With
End With
adxCat.Tables.Append adxTable
Set adxTable = Nothing

Set adxTable = New ADOX.Table
With adxTable
    .Name = "Table_2"
    With .Columns
        .Append "Column_1", adSmallInt
        .Append "Column_2", adUnsignedTinyInt
        .Append "Column_3", adInteger
        .Append "Column_4", adUnsignedTinyInt
    End With
End With
adxCat.Tables.Append adxTable
Set adxTable = Nothing
Set adxCat = Nothing

' ADODB: data
Dim adoRs1 As ADODB.Recordset, adoRs2 As ADODB.Recordset
Set adoRs1 = New ADODB.Recordset
adoRs1.Open _
    Source:="Table_1", _
    ActiveConnection:=Conn, _
    CursorType:=adOpenStatic, _
    LockType:=adLockPessimistic, _
    Options:=adCmdTable

Set adoRs2 = New ADODB.Recordset
adoRs2.Open _
    Source:="Table_2", _
    ActiveConnection:=Conn, _
    CursorType:=adOpenStatic, _
    LockType:=adLockPessimistic, _
    Options:=adCmdTable

Dim i As Long, j As Byte
For i = 1 To 100000
    With adoRs1
        .AddNew
        .Fields("Column_1") = 18
        .Fields("Column_2") = 0
        .Fields("Column_3") = i
        .Update
        For j = 1 To 10
            With adoRs2
                .AddNew
                .Fields("Column_1") = 18
                .Fields("Column_2") = 0
                .Fields("Column_3") = i
                .Fields("Column_4") = j
                .Update
            End With
        Next j
    End With
Next i

adoRs1.Close
Set adoRs1 = Nothing
adoRs2.Close
Set adoRs2 = Nothing
End Sub

combo

 

[dhookom]

Have you considered using the ADO Execute Method rather than recordsets.

Duane
Hook'D on Access
MS Access MVP

 

[combo]

I will check it - thanks.

combo