还有其他方法可以加快 N 行 INSERT INTO 语句的代码吗？

Question

我正在制作将数据插入自动编号列的代码到由两个列组成的 table。我的 Table 是 Access，前端是 Excel。我的访问 Table 包含 ID（自动编号）和基于单元格的支付码。我需要此代码以将其用作唯一 ID，稍后将 post 将其返回给 Ms Access 单独 Table。

Sub ImportJEData()
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim x As Long
Dim var
Dim PayIDnxtRow As Long

'add error handling
On Error GoTo errHandler:

'Variables for file path and last row of data
dbPath = Sheets("Update Version").Range("b1").Value
Set var = Sheets("JE FORM").Range("F14")

PayIDnxtRow = Sheets("MAX").Range("c1").Value

'Initialise the collection class variable
Set cnn = New ADODB.Connection

'Create the ADODB recordset object.
'Set rst = New ADODB.Recordset 'assign memory to the recordset

'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
'OLE stands for Object Linking and Embedding, Database




Do

    On Error Resume Next 'reset Err.obj.

         'Get the Max ID +1
        Set rst = Nothing
        Set rst = New ADODB.Recordset 'assign memory to the recordset
        SQL = "SELECT Max(ApNumber)+1 FROM PayVoucherID "
        rst.Open SQL, cnn

        'Check if the recordset is empty.
        If rst.EOF And rst.BOF Then
        'Close the recordet and the connection.
        Sheets("Max").Range("A2") = 1
        Else
        'Copy Recordset to the Temporary Cell
        Sheets("MAX").Range("A2").CopyFromRecordset rst

        End If

        'Insert the Data to Database And Check If no Errors
        Sql2 = "INSERT INTO PayVoucherID(ApNumber)Values('" & Sheets("MAX").Range("A2") & "') "
        cnn.Execute Sql2

Loop Until (Err.Number = 0)

'And if No errors COpy temporary to NEw Sub Temporary Data for Reference
Sheets("LEDGERTEMPFORM").Range("D1").Value = Sheets("MAX").Range("A2").Value



'Securing ChckID Seq Number
'ADO library is equipped with a class named Recordset
For x = 1 To PayIDnxtRow
        Set rst = Nothing
        Set rst = New ADODB.Recordset 'assign memory to the recordset
        rst.AddNew
        'Insert the Data to Database And Check If no Errors
        Sql2 = "INSERT INTO PayPaymentID(ApNumber)Values('" & Sheets("LEDGERTEMPFORM").Range("B2") & "') "
        cnn.Execute Sql2

Next x
    Set rst = Nothing
    Set rst = New ADODB.Recordset 'assign memory to the recordset
    SQL = "Select PayID From PayPaymentID where APNumber = " & Sheets("LEDGERTEMPFORM").Range("B2") & " order by PayID "
    rst.Open SQL, cnn
    Sheets("PaySeries").Range("B2").CopyFromRecordset rst




    Set rst = Nothing


rst.Close
' Close the connection
cnn.Close
'clear memory
Set rst = Nothing
Set cnn = Nothing

'communicate with the user
'MsgBox " The data has been successfully sent to the access database"

'Update the sheet
Application.ScreenUpdating = True

On Error GoTo 0
Exit Sub
errHandler:

'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
End Sub

在下面的这一节中想知道是否有另一种不使用或什至更快的循环类型的方法。


'Securing ChckID Seq Number
'ADO library is equipped with a class named Recordset
For x = 1 To PayIDnxtRow
        Set rst = Nothing
        Set rst = New ADODB.Recordset 'assign memory to the recordset
        rst.AddNew
        'Insert the Data to Database And Check If no Errors
        Sql2 = "INSERT INTO PayPaymentID(ApNumber)Values('" & Sheets("LEDGERTEMPFORM").Range("B2") & "') "
        cnn.Execute Sql2

Next x
    Set rst = Nothing
    Set rst = New ADODB.Recordset 'assign memory to the recordset
    SQL = "Select PayID From PayPaymentID where APNumber = " & Sheets("LEDGERTEMPFORM").Range("B2") & " order by PayID "
    rst.Open SQL, cnn
    Sheets("PaySeries").Range("B2").CopyFromRecordset rst

Answer 1

最后我想通了，从 40 岁到 19 岁会更好，这要归功于 @miki180 的想法。

下面是我的代码，从 DO...

Do
On Error Resume Next 'reset Err.obj.

     'Get the Max ID +1
    Set rst = Nothing
    Set rst = New ADODB.Recordset 'assign memory to the recordset
    SQL = "SELECT Max(ApNumber)+1 FROM PayVoucherID "
    rst.Open SQL, cnn

    'Check if the recordset is empty.
    'Copy Recordset to the Temporary Cell
    Sheets("MAX").Range("A2").CopyFromRecordset rst

    'Insert the Data to Database And Check If no Errors
    Sql2 = "INSERT INTO PayVoucherID(ApNumber)Values('" & Sheets("MAX").Range("A2") & "') "
    cnn.Execute Sql2

Loop Until (Err.Number = 0)

xlFilepath = Application.ThisWorkbook.FullName

SSql = "INSERT INTO PaypaymentID(Apnumber) " & _
"SELECT * FROM [Excel 12.0 Macro;HDR=YES;DATABASE=" & xlFilepath & "].[MAX$G1:G15000] where APNumber > 1"

cnn.Execute SSql

 Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset

 SQL = "Select PayID From PayPaymentID where APNumber = " & _ 
Sheets("LEDGERTEMPFORM").Range("B8") & " order by PayID "

rst.Open SQL, cnn
Sheets("PaySeries").Range("B2").CopyFromRecordset rst

还有其他方法可以加快 N 行 INSERT INTO 语句的代码吗？

Any Other Way To Speed Up Code For INSERT INTO STATEMENTS for N Rows?

sql

excel

ms-access

vba

ado