有没有其他方法可以加快 N 行的 INSERT INTO STATEMENTS 代码？

Question

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

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

我终于想通了，多亏了@miki180 的想法，它从 40 到 19 岁变得更好了。

下面是我的代码，从 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