如果我在 VBA 中从头开始创建断开连接的 ADO 记录集，如何设置 UpdateBatch 的基表信息？

Question

几周以来我一直在使用断开连接的记录集，通常从 SQL Server 检索数据，断开 rs 连接并在 VBA 中进行过滤/格式化。现在我试图做相反的事情并从头开始创建一个新的 ADO 记录集，然后将它连接到我的数据库并使用 UpdateBatch 将记录集插入数据库而不使用循环。此时我有一个完全填充的记录集，将其重新连接到我的连接字符串，然后尝试 UpdateBatch。可以理解，此时它没有关于我要更新哪个表的信息（只有通过连接字符串的数据源和初始目录）。是否有我用来提供相关表的记录集属性？此外，我尝试导入的表有一个 GUID 字段（第一个字段），我在断开连接的记录集中故意将其留空，假设在导入时，SQL Server 会自动分配此 GUID/主键。

我在“rs.UpdateBatch”之后遇到的具体错误是 运行时错误'-2147467259 (80004005)'" 用于更新或刷新的基表信息不足。

我知道我可以使用循环和 SQL 命令“INSERT INTO ...”。我想使用记录集对象，因为它们提供了更多功能作为数据容器。我没有尝试过的一件事是首先从相关表中检索记录集，然后清除它并用新数据重新填充它，以便记录集本身保留所有原始数据库和表属性。如果这是唯一/最好的方法，我也可以尝试这条路线。我只是想看看是否可以创建一个 ADO 记录集，填充它，然后将它插入到我选择的匹配表中。

dim rs as ADODB.Recordset
set rs = New ADODB.Recordset

With rs.Fields
    .append "alias", adVarChar, 255
    .append "textA", adVarChar, 255
    .append ......
End With

rs.Open
rs.AddNew Array(0, 1, 2, ..., n), Array(val0, val1, val2, ..., valn)
rs.Update

call importRS(rs)

rs.close
set rs = nothing

---

在上面的 rs.update 之后，一些记录集可能需要进入数据库，其他记录集对象只是用于加快过滤和排序，所以我只是将它们用作方便的容器，它们永远不会去 importRS()

但是，如果我需要将断开连接的记录集发送到数据库，我只想将记录集对象传递给另一个用于打开连接、发送更新和关闭连接的函数。下面的代码将达到这个目的，这就是为什么我想等到此时建立连接，就在我的 rs 被填充后的最后。

sub importRS(byref rs as ADODB.Recordset)
dim cn as ADODB.Connection
set cn = New ADODB.Connection
cn.ConnectionString = strConnection 'my connection string variable'
cn.Open

rs.ActiveConnection = cn
rs.UpdateBatch '-------error message appears on this line

cn.close
set cn = nothing

Answer 1

您可以将数据（无论它可能在哪里）放入一个数组并使用循环添加到记录集中。然后当循环完成时，您执行rs.updatebatch 如下：

Private Sub SaveToSQLSever()

 Dim lngLastRow As Long 
 Dim arrySheet As Variant
 Dim rs As ADODB.Recordset
 Dim cn As ADODB.Connection
 Dim strCn As String

    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset

    strCn= "Provider=VersionOfSQL;User ID=*********;Password=*********;" 
               & _ "Data Source=ServerName;Initial Catalog=DataBaseName"

    cn.Open strCn

    On Error Goto exiting
    '*********************************************************
    'If the data is coming from a sheet
    'Set to your Range
    With Sheets("SheetName")
        lngLastRow = .Range("A2").CurrentRegion.Rows _ 
        (.Range("A2").CurrentRegion.Rows.Count).Row
        arrySheet = .Range("A1:G" & lngLastRow).Value2      
    End With

    'Else populate the array and pass it to this Sub 
    '*************************************************************
        'Note the property parameters
        '.Source = Table That you want to populate
        With rs 
            .ActiveConnection = cn
            .Source = "Select * from TableName"   
            .CursorType = adOpenDynamic           
            .CursorLocation = adUseClient         
            .LockType = adLockBatchOptimistic
            .Open
        End With

        For i = LBound(arrySheet,1) To UBound(arrySheet,1) 
           rs.AddNew
           For j = LBound(arrySheet,2) To UBound(arrySheet,2) 
               rs.Fields(j).Value = arrySheet(i,j)
           Next j 
           rs.MoveNext
        Next i 

    rs.UpdateBatch 'Updates the table with additions from the array

       i = 0
       '******************************************************************
       'Note that you can also refer to the Field Names Explicitly Like So: 
        For i = LBound(arryData,1) To UBound(arryData,1) 
            With rs 
               .AddNew

               .Fields("FieldName1").Value = arryData(i,1)
               .Fields("FieldName2").Value = arryData(i,2)
               .Fields("FieldName3").Value = arryData(i,3)
               .Fields("FieldName4").Value = arryData(i,4)
               .Fields("FieldName5").Value = arryData(i,5)
               .Fields("FieldName6").Value = arryData(i,6)
               .Fields("FieldName7").Value = arryData(i,7)
            End With 
        Next i

       rs.UpdateBatch
      '******************************************************************
    MsgBox "The data has successfully been saved to the SQL Server", _ 
    vbInformation + vbOKOnly,"Alert: Upload Successful"

exiting:
    If cn.State > 0 Then cn.Close
    If rs.State > 0 Then rs.Close
    Set cn = Nothing
    Set rs = Nothing

End Sub

编辑：根据 OP 将现有记录集传递给 SQL 表的请求，下面应该这样做：

Private Sub SendRcrdsetToSQL(ByRef rsIn As ADODB.Recordset)

 Dim arrySheet As Variant
 Dim rsSQL As ADODB.Recordset
 Dim cn As ADODB.Connection
 Dim strCn As String

    Set cn = New ADODB.Connection

    strCn= "Provider=VersionOfSQL;User ID=*********;Password=*********;" 
               & _ "Data Source=ServerName;Initial Catalog=DataBaseName"

    cn.Open strCn

    On Error Goto exiting
    Set rsSQL = New ADODB.Recordset
        With rsSQL 
            .ActiveConnection = cn
            .Source = "Select * from TableName"   
            .CursorType = adOpenDynamic           
            .CursorLocation = adUseClient         
            .LockType = adLockBatchOptimistic
            .Open
        End With

       'disconnect the recordset and close the connection
        Set rsSQL.ActiveConnection = Nothing

        cn.Close
        Set cn = Nothing

        rsIn.MoveFirst    

        rsSQL.MoveLast

        'Add the records from the passed recordset to the SQL recordset
        Do While Not rsIn.EOF

            With rsSQL 
                   .AddNew

                   .Fields("FieldName1").Value = rsIn.Fields("FieldName1").Value
                   .Fields("FieldName2").Value = rsIn.Fields("FieldName2").Value
                   .Fields("FieldName3").Value = rsIn.Fields("FieldName3").Value
                   .Fields("FieldName4").Value = rsIn.Fields("FieldName4").Value
                   .Fields("FieldName5").Value = rsIn.Fields("FieldName5").Value
                   .Fields("FieldName6").Value = rsIn.Fields("FieldName6").Value
                   .Fields("FieldName7").Value = rsIn.Fields("FieldName7").Value
            End With 

            rsIn.MoveNext
        Loop

    rsSQL.UpdateBatch

    MsgBox "The data has successfully been saved to the SQL Server", _ 
    vbInformation + vbOKOnly,"Alert: Upload Successful"

exiting:
    If cn.State > 0 Then cn.Close
    If rsIn.State > 0 Then rsIn.Close
    If rsSQL.State > 0 Then rsSQL.Close
    Set cn = Nothing
    Set rsIn = Nothing
    Set rsSQL = Nothing

End Sub

Answer 2

我能够让它工作的唯一方法是运行一个查询来构建我的 Recordset 的结构。所以你的代码变成了这样：

Private Sub Command1_Click()
   Dim cn As ADODB.Connection
   Set cn = New ADODB.Connection
   cn.ConnectionString = "<your connection string>"
   cn.CursorLocation = adUseClient
   cn.Open

   Dim rs As ADODB.Recordset
   Set rs = New ADODB.Recordset
   Set rs.ActiveConnection = cn
   rs.Open "select * from states where 1<>1", , adOpenStatic, adLockBatchOptimistic
   rs.AddNew Array("Abbrev", "Name", "Region", "SchoolDataDirect"), Array("TN", "TestName", "MyRegion", 1)
   Set rs.ActiveConnection = Nothing

   cn.Close

   ImportRS rs
End Sub

Private Sub ImportRS(ByRef rs As ADODB.Recordset)
   Dim cn As ADODB.Connection
   Set cn = New ADODB.Connection
   cn.ConnectionString = "<your connection string>"
   cn.CursorLocation = adUseClient
   cn.Open

   Set rs.ActiveConnection = cn
   rs.UpdateBatch
   Set rs.ActiveConnection = Nothing

   cn.Close
End Sub