我正在编写代码，将数据插入由两列组成的表的自动编号列中。我的表格是access，前端是excel。我的访问表包含id（autonumber）和paycode（基于单元格）。我需要这个代码来使用它作为唯一的ID，稍后将发布回ms访问单独的表。

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