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

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

2 个答案: