If i create a disconnected ADO recordset from scratch in VBA how do i set the base table information for UpdateBatch? - vba

Question

I have been using disconnected recordsets for a few weeks now, typically retrieving data from SQL Server, disconnecting the rs and filtering/formatting in VBA. Now i'm trying to do the reverse and create a new ADO recordset from scratch, and then connect it to my database and use UpdateBatch to insert the recordset into the database without using a loop. I have a fully populated recordset at this point, hooked it back up to my connection string, and try UpdateBatch. Understandably, it has no information at this point about what table I'm trying to update (only Data Source and Initial Catalog via the connection string). Is there a recordset property that I use to provide the table in question? Additionally, the table I'm trying to import into has a GUID field (first field) that I have left blank on purpose in my disconnected recordset assuming that upon import, SQL Server would assign this GUID/primary key automatically.
The specific error I'm getting after "rs.UpdateBatch" is
Run-time error '-2147467259 (80004005)'"
Insufficient base table information for updating or refreshing.
I know I could use a loop and a SQL command "INSERT INTO ...". I'd like to use a recordset object though since those provide much more functionality as a container for data. One thing I haven't tried is to first retrieve a recordset from the table in question, then clear it and re-populate it with the new data so that the recordset itself retains all of the original database and table properties. If that's the only/best approach I can try that route too. I just wanted to see if it was possible to create an ADO recordset, populate it, and then insert it into a matching table of my choice.
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
After rs.update above some recordsets may need to go to a database, other recordset objects are just used to expedite filtering and sorting so I just use them as a convenient container and they'd never go to importRS()
However, IF I need to send the disconnected recordset to a database, i'd like to just pass the recordset object to another function that serves the purpose of opening the connection, sending the update, and closing the connection. The code below would serve that purpose which is why i'd like to wait to establish a connection until this point, right at the end after my rs is populated.
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

You can get the data, (wherever it may be) into an array and add to the recordset using a loop. Then then when the loop is finished, you do rs.updatebatch as follows:
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: As per OP's request to pass an existing recordset to a SQL table, below should do so:
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

The only way I was able to get this to work was by running a query to build the structure of my Recordset. So your code becomes something like this:
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