Если я создаю отключенный набор записей ADO с нуля в VBA, как мне установить информацию базовой таблицы для 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

Edit: В соответствии с запросом 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

Единственный способ заставить это работать - это выполнить запрос для построения структуры моего набора записей.Таким образом, ваш код становится примерно таким:

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