【发布时间】：2022-06-15 02:22:10
【问题描述】：
需要一些帮助。我在 How to increase performance for bulk INSERTs to ODBC linked tables in Access? 处获取了 Gord Thompson 的代码并对其进行了修改以适合我的情况。
我正在尝试将名为“bulk_insert”的查询（基于 MS Access DB 中的本地表）的内容复制到名为 dbo_tblCVR_Matching_tmp 的 SQL 链接表中。该查询没有计算字段或函数或什么都没有，只有 102 列普通数据。我目前正在测试 6K 到 10K 记录范围内的文件。
在我收到此线程标题中的错误之前，代码执行并复制了许多记录。我环顾四周，但没有什么可以帮助我解决我的特定问题。不确定我是否必须清除或刷新某些内容。这是我正在使用的 2 个例程：
'==============================================================
'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
这是代码经过一百万次测试后的最终版本，以防万一有人遇到我同样的问题。再次感谢 Albert Kallal 帮助我解决这个问题。
我在代码中添加了一些 cmets 以及其他信息，以便让这件事一次性运行。
就我而言，
-
我在查询记录之前处理了所有重复项（即，我创建了一个追加查询以将记录复制到具有主键的本地表）
-
创建了一个直通查询“p”
-
使用函数帮助我转义单引号字符等字符并处理空值和空白
-
集成了一个 dlookup 函数，以防止我对查询中每一列的名称进行硬编码而发疯。还允许过滤空列以最大化使用块大小
'=============================================== ============== '归功于 Albert Kalal 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结束
Dim RowsInChunk As Long ' 这将显示适合块的行 Dim RowCountOut 只要 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 IfrstLocal.MoveNext
循环
' 发送最后一批（如果有） 如果 sValues "" 那么 使用 CurrentDb.QueryDefs("p") ' 在此处使用传递查询。我命名我的'p' .sql = sBASE & sValues 。执行 结束于 sValues = "" 结束如果
rstLocal.关闭 t = 定时器 - t Debug.Print "done - time = " & t '在即时窗口上显示关于子总持续时间的信息 结束子
====这是sql_escape函数========
' 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
【问题讨论】：
-
你的字符串会很大。为什么不把它分成多批插入
-
If i = 1000 Then可能会减少到 200 左右，然后尝试一下......