Getting ODBC - System Resources Exceeded (Rutime error 3035)-CodePudding

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

CodePudding user response：

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.