Getting ODBC - System Resources Exceeded (Rutime error 3035)

Question

Need some assistance. I took Gord Thompson's code here How to increase performance for bulk INSERTs to ODBC linked tables in Access? and modified it to fit my case.

I am trying to copy the contents of a query called 'bulk_insert' (which is based on a local table in MS Access DB) into a SQL linked table called dbo_tblCVR_Matching_tmp. The query has no calculated fields or functions or nothing, just 102 columns of plain data. I'm currently testing with files in the range of 6K to 10K records.

The code executes and it copies many records over before I get the error in the title of this thread. I have looked around, but there is nothing that would help me with my particular issue. Not sure if I have to clear or refresh something. Here is the 2 routines I'm using:

'==============================================================
'Gord Thompson  Stackoverflow: https://stackoverflow.com/questions/25863473/how-to-increase-performance-for-bulk-inserts-to-odbc-linked-tables-in-access
'==============================================================

Sub bulk_insert()
    Dim cdb As DAO.Database
    Dim rst As DAO.Recordset
    Dim t0 As Single
    Dim i As Long
    Dim c As Long
    Dim valueList As String
    Dim separator As String
    Dim separator2 As String

t0 = Timer
Set cdb = CurrentDb
Set rst = cdb.OpenRecordset("SELECT * FROM bulk_insert", dbOpenSnapshot)
i = 0
valueList = ""
separator = ""

Do Until rst.EOF
    i = i + 1
    valueList = valueList & separator & "("
    separator2 = ""
    For c = 0 To rst.Fields.Count - 1
        
        valueList = valueList & separator2 & "'" & rst.Fields(c) & "'"
        If c = 0 Then
            separator2 = ","
        End If
    Next c
    valueList = valueList & ")"
    
    If i = 1 Then
        separator = ","
    End If
    If i = 1000 Then
        SendInsert valueList
        i = 0
        valueList = ""
        separator = ""
    End If
    rst.MoveNext
Loop

If i > 0 Then
    SendInsert valueList
End If
rst.Close
Set rst = Nothing
Set cdb = Nothing
Debug.Print "Elapsed time " & Format(Timer - t0, "0.0") & " seconds."
End Sub

'==============================================================

Sub SendInsert(valueList As String)
Dim cdb As DAO.Database
Dim qdf As DAO.QueryDef

Set cdb = CurrentDb
Set qdf = cdb.CreateQueryDef("")

qdf.Connect = cdb.TableDefs("dbo_tblCVR_Matching_tmp").Connect
qdf.ReturnsRecords = False
qdf.sql = "INSERT INTO dbo.tblCVR_Matching_tmp (" & _
"Associate_Id , Recd_Date, Price_Sheet_Eff_Date, VenAlpha, Mfg_Name, Mfg_Model_Num, Fei_Alt1_Code, Mfg_Product_Num, Base_Model_Num, Product_Description," & _
"Qty_Base_UOM , Price_Invoice_UOM, Mfr_Pub_Sugg_List_Price, Mfr_Net_Price, IMAP_Pricing, Min_Order_Qty, UPC_GTIN, Each_Weight, Each_Length, Each_Width," & _
"Each_Height, Inner_Pack_GTIN_Num, Inner_Pack_Qty, Inner_Pack_Weight, Inner_Pack_Length, Inner_Pack_Width, Inner_Pack_Height, Case_GTIN_Num, Case_Qty," & _
"Case_Weight, Case_Length, Case_Width, Case_Height, Pallet_GTIN_Num, Pallet_Qty, Pallet_Weight, Pallet_Length, Pallet_Width, Pallet_Height, Pub_Price_Sheet_Eff_Date," & _
"Price_Sheet_Name_Num, Obsolete_YN, Obsolete_Date, Obsolete_Stock_Avail_YN, Direct_Replacement, Substitution, Shelf_Life_YN, Shelf_Life_Time, Shelf_Life_UOM," & _
"Serial_Num_Req_YN, LeadLaw_Compliant_YN, LeadLaw_3rd_Party_Cert_YN, LeadLaw_NonPotable_YN, Compliant_Prod_Sub, Compliant_Prod_Plan_Ship_Date, Green, GPF, GPM," & _
"GPC, Freight_Class, Gasket_Material, Battery_YN, Battery_Type, Battery_Count, MSDS_YN, MSDS_Weblink, Hazmat_YN, UN_NA_Num, Proper_Shipping_Name," & _
"Hazard_Class_Num, Packing_Group, Chemical_Name, ORMD_YN, NFPA_Storage_Class, Kit_YN, Load_Factor, Product_Returnable_YN, Product_Discount_Category," & _
"UNSPSC_Code, Country_Origin, Region_Restrict_YN, Region_Restrict_Regulations, Region_Restrict_States, Prop65_Eligibile_YN, Prop65_Chemical_Birth_Defect," & _
"Prop65_Chemical_Cancer, Prop65_Chemical_Reproductive, Prop65_Warning, CEC_Applicable_YN, CEC_Listed_YN, CEC_Model_Num, CEC_InProcess_YN, CEC_Compliant_Sub," & _
"CEC_Compliant_Sub_Cross_YN, Product_Family_Name, Finish, Kitchen_Bathroom, Avail_Order_Date, FEI_Exclusive_YN, MISC1, MISC2, MISC3" & _
    ") Values " & valueList

'this is the line that is always highlighted when the error occurs
    qdf.Execute dbFailOnError
    Set qdf = Nothing
    Set cdb = Nothing
    
End Sub

This is the final version of the code after testing it a million times, just in case someone runs into my same issue. Again thx to Albert Kallal for helping me out on this.

I added some comments in the code as well as additional information to get this thing working on one go.

In my case,

I took care of any duplicates before querying the records (i.e. I created an append query to copy the records to a local table with a primary key)
Created a pass through query 'p'
Used a function to help me escape chars such as the single quote char and deal with nulls and blanks

Integrated a dlookup function to prevent me from going crazy on hard coding the names of every column on my query. Also to allow filtering of empty columns to maximize the use of the chunk size

' ============================================================= ' Credit to Albert Kallal Getting ODBC - System Resources Exceeded (Rutime error 3035) ' =============================================================

Sub bulk_insert()

         Dim rstLocal  As DAO.Recordset
     Set rstLocal = CurrentDb.OpenRecordset("bi") 'bi is the name of the query I'm using to list of the records in the bulk

     Dim sBASE      As String      ' base sql insert string
     Dim sValues    As String      ' our values() list built up

     Dim t As Single
     t = Timer

     Dim i          As Long
     Dim j          As Long
     Dim c As Long
     Dim ChunkSize  As Long    ' # length size of "text" to send to server
     Dim separator2 As String
     Dim potentialHeader As String
     Dim test
     Dim filledArray() As Long

     ChunkSize = 48000        'chunk size / or number of chars

     'Try to programmatically create the insert, we will also remove anything that doesn't have values

     With rstLocal
         If Not rstLocal.EOF Then
             sBASE = "INSERT INTO dbo.tblCVR_Matching_tmp ("  'this is where I added my SQL table
             ReDim filledArray(0 To .Fields.Count - 1)
             separator2 = ""
             For c = 0 To .Fields.Count - 1 'using loop to get all the headers in my query
                 potentialHeader = .Fields(c).Name

                 test = DLookup(potentialHeader, "bi", potentialHeader & " is not null") 'using the dlookup function to isolate headers from my query that have values in its column

                 If test <> "" Then
                     filledArray(c) = 1
                     sBASE = sBASE & separator2 & potentialHeader
                     separator2 = ","
                 Else
                     filledArray(c) = 0
                 End If
             Next c

             sBASE = sBASE & ") VALUES "
         End If
     End With

     Dim RowsInChunk  As Long  ' this will show rows that fit into a chunk
     Dim RowCountOut  As Long
     sValues = ""
     Do While rstLocal.EOF = False
         RowCountOut = RowCountOut + 1

     If sValues <> "" Then sValues = sValues & ","

     RowsInChunk = RowsInChunk + 1
     sValues = sValues & "("
     separator2 = ""

     With rstLocal
         For c = 0 To .Fields.Count - 1
             If filledArray(c) = 1 Then
                 sValues = sValues & separator2 & sql_escape(.Fields(c)) 'using sql_escape function for cells that have 'null' or single quotes... the function helps escape the characters to avoid getting errors on the insert
                 separator2 = ","
             Else
                 'SKIP IF ALL NULLS
             End If
         Next c
     End With

     sValues = sValues & ")"

     If (Len(sBASE) + Len(sValues)) >= ChunkSize Then
         'send data to server
         With CurrentDb.QueryDefs("p")
             .sql = sBASE & sValues
             .Execute
         End With

         Debug.Print "Rows in batch = " & RowsInChunk 'displays the number of rows per batch sent on each bulk insert statement
         RowsInChunk = 0
         sValues = ""
         DoEvents
     End If

         rstLocal.MoveNext

     Loop

         ' send out last batch (if any)
         If sValues <> "" Then
             With CurrentDb.QueryDefs("p") 'using pass through query here. I named mine 'p'
                 .sql = sBASE & sValues
                 .Execute
             End With
             sValues = ""
         End If

         rstLocal.Close
         t = Timer - t
     Debug.Print "done - time = " & t 'displays information on the immediate window as to the total duration of the sub

 End Sub

====this is the sql_escape function========

' detects if a values is string or null and properly escapes it
Public Function sql_escape(val As Variant)
    If LCase(val) = "null" Or val = "" Or IsNull(val) Then
        sql_escape = "NULL"
    Else
        ' also need to escape "'" for proper sql
        val = Replace(val, "'", "''")
        sql_escape = "'" & val & "'"
    End If
End Function

Your string is going to be huge. Why not break it into multiple batches of inserts — dbmitch, Jun 06 '22 at 22:04
`If i = 1000 Then` maybe reduce that to 200 or so and try it... — Tim Williams, Jun 06 '22 at 22:05

score 1 · Accepted Answer · answered Jun 06 '22 at 23:34

In your loop, put in a test for the value length.

I would trigger the insert at about 4000 characters, maybe try 8000.

Also, you want to use a pass-though query for this, else it will be slow.

So, the code will be say like you have, but make sure the output format is in t-sql (sql server) format, and not JET/ACE sql format.

Note that sql server DOES have a short hand for inserts, and we WANT to use that fact since this reduces the overhead (the sql syntax) by a large amount (and looking at your code, you DO seem to be doing this).

So, the formart we want is this:

INSERT INTO tblBig (ID, FirstName, LastName, City)

       VALUES (134, 'Albert', 'Kallal', 'Edmonton'),
       VALUES (134, 'Albert', 'Kallal', 'Edmonton'),
       VALUES (134, 'Albert', 'Kallal', 'Edmonton');

Note how we only need ONE insert command for many rows.

So, our code stub will look like this:

Sub TestAppendNeedForSpeed()

  ' I wanted to allow PK inserts
  With CurrentDb.QueryDefs("qryPass1")
      .SQL = "SET IDENTITY_INSERT TBLbIG1 ON;"
      .Execute
  End With


  Dim rstLocal  As dao.Recordset
  Set rstLocal = CurrentDb.OpenRecordset("tblBig")

  Dim sBASE      As String      ' base sql insert string
  Dim sValues    As String      ' our values() list built up

  Dim t As Single
  t = Timer

  Dim i          As Long
  Dim j          As Long
  Dim ChunkSize  As Long    ' # length size of "text" to send to server

  ChunkSize = 4000        ' I don't think going higher will help

  sBASE = "INSERT INTO tblBig1 (ID,FirstName,LastName,City) VALUES "

  Dim RowsInChunk  As Long  ' this will show rows that fit into a chunk - only FYI
  Dim RowCountOut  As Long
  sValues = ""
  Do While rstLocal.EOF = False
    RowCountOut = RowCountOut + 1
  
    If sValues <> "" Then sValues = sValues & ","
    RowsInChunk = RowsInChunk + 1
      With rstLocal
          sValues = sValues & "(" & !ID & "," & qu(!FirstName) & "," & qu(!LastName) & "," & qu(!City) & ")"
      End With
      
      If (Len(sBASE) + Len(sValues)) >= ChunkSize Then
        ' send data to server
        With CurrentDb.QueryDefs("qryPass1")
          .SQL = sBASE & sValues
          .Execute
        End With
    
        Debug.Print "(" & RowCount & ") -- buffer out - " & RowsInChunk
        RowsInChunk = 0
        sValues = ""
        DoEvents
    End If
    
    rstLocal.MoveNext
    
Loop
' send out last batch (if any)
If sValues <> "" Then
  With CurrentDb.QueryDefs("qryPass1")
    .SQL = sBASE & sValues
    .Execute
  End With
  sValues = ""
End If

  rstLocal.Close
    t = Timer - t
   Debug.Print "done - time = " & t

End Sub

So, the way we have this laid out, we can set/tweak/test/try the best chunk size.

You not even close and in the same ball part to insert 4000 rows at a time. Try about 4000 characters, maybe 8000. Some systems, I seen about 12000 char chunk size work best.

And as noted, use the above pass-though query idea - it will also run MUCH faster.

You can expect about 15x to 20x speed improvement with above. So, in place of say 120 minutes, you see about 6 minutes of time.

So, use the above template and approach. Of course the ONE row of values could be an external sub (or function) call, but the above approach will get you the best speed.

Thx so much Albert for the template and the valuable information shared. A few tweaks were made on my end, but the final solution preserved the main components. — nrage21, Jun 08 '22 at 12:35

Getting ODBC - System Resources Exceeded (Rutime error 3035)

1 Answers1