This is the code I'm using to update an SQL database:
Public Sub main()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
cnn.Open "ConnectionName"
rst.ActiveConnection = cnn
rst.CursorLocation = adUseServer
rst.Source = "Update Table ..."
rst.Open
Set rst = Nothing
Set cnn = Nothing
End Sub
What I want to know is if and how I should deal with the rst object after opening it. Do I close it? When I try doing rst.Close, I get the error: "Operation is not allowed when the object is closed". The code works fine without rst.Close, I'm wondering if there are any dangers to not closing the object.
An UPDATE operation does not return a resultset. Therefore, if executed with a Recordset object, it results in an empty and closed recordset. It cannot be closed anyway because it has never been opened.
A rule of thumb is:
if rst.State <> adStateClosed then rst.Close
But, because you are executing a command that's not going to return data anyway, the preferred way is:
dim cm as ADODB.Command
set cm = new adodb.command
set cm.activeconnection = cnn
cm.commandtype = adCmdText
cm.commandtext = "UPDATE ..."
cm.execute ,, adExecuteNoRecords
Or, if your SQL is a fixed string that doesn't have parameters,
cnn.execute "UPDATE ...",, adExecuteNoRecords
Also, please change rst.ActiveConnection = cnn to Set rst.ActiveConnection = cnn.
An update returns no rows, so no need to open a recordset.
You can execute the statement directly using:
Connection.Execute "Update Table ...", [flags]
To answer your question, after .Open the recordset is closed (its .state will be adStateClosed) as no data has been returned, so setting it to nothing is sufficent.
Related
I am trying to get a single itemcode from a SQL Server table (items) to be compared with an itemcode entered in an Excel sheet. To make this possible I have written the following VBA code in Excel 2019.
Function GetItemcodeFromSQLTable(sSQLArtikel As String) As String
Dim connection As New ADODB.connection
connection.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Data Source=SQL01;Initial Catalog=110"
Dim query As String
query = "select itemcode from items where itemcode = " & sSQLArtikel
Dim rs As New ADODB.Recordset
rs.Open query, connection
connection.Close
End Function
I keep getting an error executing the line rs.open query, connection.
The purpose of this all is that I want to know if an itemcode already exists in the SQL table or not. If not, the rest of my VBA code wil create a XML file to import a new itemcode into the SQL table.
I have added a reference to "Microsoft Active X Data Objects 6.1 Library" in the VBA window.
Can anybody help me with this problem?
Many thanks.
The code I am using now is
Function CheckIfArticleCodeExistsInSQLDatabase(sSQLArtikel As String) As String
Dim query As String
Dim connection As ADODB.connection
Dim rs As ADODB.Record
Dim cmd As ADODB.Command
' PREPARED STATEMENT WITH PARAM PLACEHOLDERS
query = "select itemcode from items where itemcode = " & "'" & sSQLArtikel & "'"
' OPEN CONNECTION
Set connection = New ADODB.connection
connection.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;" _
& "Data Source=SQL01;Initial Catalog=110"
' DEFINE COMMAND AND RECORDSET
Set cmd = New ADODB.Command
cmd.ActiveConnection = connection
Set rs = cmd.Execute(query, sSQLArtikel) ' BIND PARAM VALUES
' ... DO SOMETHING WITH rs
rs.Close: connection.Close
Set cmd = Nothing: Set rs = Nothing: Set connection = Nothing
End Function
When executing the command "Set rs = cmd.Execute(query, sSQLArtikel)" an errormessage is displayed "the command text is not set for the command object".
I am doing something wrong but what?
Consider the industry best practice of parameterization whenever running SQL in application layer like VBA. Doing so, you avoid the need to concatenate and punctuate variables to an SQL string.
Specifically, the missing quotes around string literals (sSQLArtikel) is your issue. With ADO Command.Execute, you can define recordsets with binded parameters.
Dim query As String
Dim connection As ADODB.Connection
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
' PREPARED STATEMENT WITH PARAM PLACEHOLDERS
query = "select itemcode from items where itemcode = ?"
' OPEN CONNECTION
Set connection = New ADODB.Connection
connection.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;" _
& "Data Source=SQL01;Initial Catalog=110"
' DEFINE COMMAND AND RECORDSET
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = connection
.CommandType = adCmdText
.CommandText = query
.Parameters.Append .CreateParameter(, adVarChar, adParamInput, _
Len(sSQLArtikel), sSQLArtikel)
Set rs = .Execute
End With
' ... DO SOMETHING WITH rs
rs.Close: connection.Close
Set cmd = Nothing: Set rs = Nothing: Set connection = Nothing
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
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
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
I have a function that is passed a SQL string, queries a SQL server, and return the results via a an array. This function works perfectly the first time, but I try to call it again it get:
Operation is not allowed when the object is closed
Oddly enough this error occures right after the Open statement. I've Googled about everything I can think of, with no good results.
Public Function SQL_Query(SQLCommand As String) As Variant
Dim cn As New ADODB.Connection
Dim SQLrs As New ADODB.Recordset
cn.ConnectionString = "Provider=SQLNCLI11;Server=10.XXX.XXXX.XXX;DataBase=Database1;Trusted_Connection=yes;"
cn.Open
SQLrs.CursorLocation = adUseClient
Call SQLrs.Open(SQLCommand, cn, adOpenStatic, adLockBatchOptimistic)
SQLrs.MoveFirst
SQL_Query = RecordSet2Array(SQLrs.GetRows)
SQLrs.Close
Set SQLrs = Nothing
cn.Close
Set cn = Nothing
End Function
If I'm reading right - you're opening the SQL connection again, but not the recordset (SQLrs). You have to create a new instance each time on open and close both when done, or you tend to get these issues on re-running.
I've not experienced it personally, but I've been told that Dim x as NEW y can lead to issues.
Try this change to see if it helps:
Public Function SQL_Query(SQLCommand As String) As Variant
'changes here vvvvvvvv
Dim cn As ADODB.Connection
Dim SQLrs As ADODB.Recordset
Set cn = New ADODB.Connection
Set SQLrs = New ADODB.Recordset
'to here ^^^^^^^^^^^^^^
cn.ConnectionString = "Provider=SQLNCLI11;Server=10.XXX.XXXX.XXX;DataBase=Database1;Trusted_Connection=yes;"
cn.Open
SQLrs.CursorLocation = adUseClient
Call SQLrs.Open(SQLCommand, cn, adOpenStatic, adLockBatchOptimistic)
SQLrs.MoveFirst
SQL_Query = RecordSet2Array(SQLrs.GetRows)
SQLrs.Close
Set SQLrs = Nothing
cn.Close
Set cn = Nothing
End Function
So, I've finally tracked this to SQL query I was using in my second call to the function. It creates a temp table and returns records from that temp table. This is apparently and known issue. However it's easily corrected by SET NOCOUNT ON. So I've updated my code to the following and everything is working fine now.
Public Function SQL_Query(SQLCommand As String) As Variant
Dim cn As New ADODB.Connection
Dim SQLrs As New ADODB.Recordset
cn.ConnectionString = "Provider=SQLNCLI11;Server=10.XXX.XXXX.XXX;DataBase=Database1;Trusted_Connection=yes;"
cn.Open
cn.Execute "SET NOCOUNT ON"
SQLrs.CursorLocation = adUseClient
Call SQLrs.Open(SQLCommand, cn, adOpenStatic, adLockBatchOptimistic)
SQLrs.MoveFirst
SQL_Query = RecordSet2Array(SQLrs.GetRows)
SQLrs.Close
Set SQLrs = Nothing
cn.Close
Set cn = Nothing
End Function
Here is my problem: I need to get data from .mdb file that is on the network hard drive. I am using ADODB to connect to it, but when i try to return field value from RecordSet that i created it returns error:
Operation is not allowed when the object is closed
Here is my code:
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command
cmd.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ".mdb"
cmd.CommandText = SQLRequst
cmd.CommandType = adCmdText
cmd.CommandTimeout = 900
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
Debug.Print rs.Fields(0)
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Set rs.ActiveConnection = Nothing
At the moment i tried many different types of connection. The main thing thats makes me confused is that it connects to .mdb file and also creates RecordSet but most values are set to "Operation is not allowed when object is closed"
I think the problem is with the way i am connecting and getting records sets because I use same method to connect to sql database and it works just fine.
Any help will be appreciated
*Edited : SQLRequest = "SELECT * FROM tblStack WHERE StackID=XXXXX"
Changed code to this:
Dim rs As New ADODB.Recordset
Dim conn As New ADODB.Connection
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ".mdb"
rs.Open SQLRequst, conn, adOpenForwardOnly, adLockReadOnly
Debug.Print rs.Fields(0)
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Set rs.ActiveConnection = Nothing
Still debug doesn't print anything and in Locals window shows that Fields(0).Value Operation is not allowed when the object is closed
Problem was in SQLRequst string :
SQLRequest = "SELECT * FROM tblStack WHERE StackID='XXXXX'"
It needed ''.
I just startied working with this database and I have a small problem.
So the main idea behind this is to use VBA to get needed information from database that I can use later on.
I am using ADO recordset and connect sting to connect to server. All is fine apart from one problem: when I am creating RecordSet by using SQL request it only returns one field when i know there should me more. At the moment I think that RecordSet is just grabbing first result and storing it in but looses anything else that should be there. Can you please help me.
Here is my code:
'Declare variables'
Dim objMyConn As ADODB.Connection
Dim objMyCmd As ADODB.Command
Dim objMyRecordset As ADODB.Recordset
Dim fldEach As ADODB.Field
Dim OrderNumber As Long
OrderNumber = 172783
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
'Open Connection'
objMyConn.ConnectionString = "Provider=SQLOLEDB;Data Source=Local;" & _
"Initial Catalog=SQL_LIVE;"
objMyConn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText = "SELECT fldImage FROM tblCustomisations WHERE fldOrderID=" & OrderNumber
objMyCmd.CommandType = adCmdText
'Open Recordset'
Set objMyRecordset.Source = objMyCmd
objMyRecordset.Open
objMyRecordset.MoveFirst
For Each fldEach In objMyRecordset.Fields
Debug.Print fldEach.Value
Next
At the moment Debug returns only one result when it should return two because there are two rows with the same OrderID.
The recordset only opens a single record at a time. You are iterating through all the fields in a single record. Not each record in the recordset.
If your query returns two records, you need to tell the Recordset to advance to the next one.
A query returns one recordset which has some number of records which have some number of fields.
You are iterating through the fields only for one record in the returned recordset.
You can do this with a few ways, but I generally do something like:
objMyRecordset.MoveFirst
Do
If Not objMyRecordset.EOF Then
debug.print "Record Opened - only returning 1 field due to SQL query"
For Each fldEach In objMyRecordset.Fields
Debug.Print fldEach.Value
Next
'this moves to the NEXT record in the recordset
objMyRecordset.MoveNext
Else
Exit Do
End If
Loop
Note that if you want to include more fields you will need to modify this line:
objMyCmd.CommandText = "SELECT fldImage FROM tblCustomisations WHERE fldOrderID=" & OrderNumber
To include whatever additional fields you want returned.
In addition to the #enderland's answer, you can also have a disconnected RecordSet, that have all the values and fields ready for consumption. It's handy when you need to pass the data around or need to close the connection fast.
Here's a function that returns a disconnected RecordSet:
Function RunSQLReturnRS(sqlstmt, params())
On Error Resume next
' Create the ADO objects
Dim rs , cmd
Set rs = server.createobject("ADODB.Recordset")
Set cmd = server.createobject("ADODB.Command")
' Init the ADO objects & the stored proc parameters
cmd.ActiveConnection = GetConnectionString()
cmd.CommandText = sqlstmt
cmd.CommandType = adCmdText
cmd.CommandTimeout = 900 ' 15 minutos
collectParams cmd, params
' Execute the query for readonly
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
If err.number > 0 then
BuildErrorMessage()
exit function
end if
' Disconnect the recordset
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Set rs.ActiveConnection = Nothing
' Return the resultant recordset
Set RunSQLReturnRS = rs
End Function
You are mixing up terms in your question which makes it unclear
In your first paragraph you describe a problem with "Fields", in the last paragraph you turn it into "Rows". Not exactly the same.
But whatever you are trying to achieve, the code you wrote will only return one field and one row.
If you want all FIELDS, your query should be:
objMyCmd.CommandText = "SELECT * FROM tblCustomisations WHERE fldOrderID=" & OrderNumber
If you want all ROWS, your loop should be:
objMyRecordset.MoveFirst
If Not objMyRecordset.BOF Then
While Not objMyRecordset.EOF
debug.print objMyRecordset!fldImage
RS.MoveNext
Wend
End If