When I use the code below to connect to an access database from Excel, I get error 3704 "Operation is not allowed when the object is closed." at line
Call .Offset(1, 0).CopyFromRecordset(rstRecordSet)
I can 'fix' this problem by commenting out the line
adoConnection.Close
but I really don't like that, or understand why it solves the problem.
Can anyone explain what's wrong and how to fix it?
Thanks
Private Const constStrDBPath As String = "H:\Projects\DP.mdb"
Private Const constStrConnection As String = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & constStrDBPath & ";" & _
"Jet OLEDB:Engine Type=5;" & _
"Persist Security Info=False;"
Public Function SelectStatement(strCommandText As String) As Object
Dim adoConnection As New ADODB.Connection
Dim adoCommand As New ADODB.Command
Dim rstRecordSet As New ADODB.Recordset
adoCommand.CommandText = strCommandText
adoConnection.Open constStrConnection
adoCommand.ActiveConnection = adoConnection
'create the recordset by executing command string
Set rstRecordSet = adoCommand.Execute(, , adadoCommandText)
Set SelectStatement = rstRecordSet
' clean up
adoConnection.Close
Set rstRecordSet = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing
End Function
Sub TestSelect()
Dim rstRecordSet As Object
Dim lngField As Long
Set rstRecordSet = SelectStatement("SELECT * FROM tblSystem")
If Not rstRecordSet Is Nothing Then
With Sheet1.Range("A1")
For lngField = 1 To rstRecordSet.Fields.Count
.Cells(1, lngField).Value = rstRecordSet.Fields(lngField - 1).Name
Next lngField
Call .Offset(1, 0).CopyFromRecordset(rstRecordSet)
End With
End If
End Sub
Your function SelectStatement is not fetching (reading) anything from the database.
In plain terms your actual SelectStatement() opens a channel with Access, prepares the query, sets a cursor and then throws away all.
The cleanup phase has to be postponed after having read the last recordset.
Related
I am working on a project where I'm using SQL to return records from a database into a listbox using userinput. Things are fine when there's more than one result, the listbox reads properly. However, when there's only one record, it doesn't transpose it like it does with all the others. Multiple Returns Single Return
I've tried to do an "if employeeoutput.recordcount = 1 then don't transpose" type of thing, but that still sends me with the Single Return.
Private Sub cmdSearch_Click()
Stop
'connect to database
'make dynamic code
'profit
'set up DB and Recordset
Dim calldbconn As ADODB.Connection
Dim EmployeeOutput As ADODB.Recordset
Dim EmpData As Variant
'its a special tool we're going to use later
Dim InContactInput As String
Dim FNameInput As String
Dim LNameInput As String
Dim TeamNameInput As String
Dim TeamNumberInput As Integer
Dim SQLString As String
'set it up for a new recordset
Set calldbconn = New ADODB.Connection
Set EmployeeOutput = New ADODB.Recordset
'set the vars
InContactInput = txtInContactNum.Value
FNameInput = txtFirstName.Value
LNameInput = txtLastName.Value
TeamNameInput = cboTeamName.Value
TeamNumberInput = cboTeamName.ListIndex + 1
'---------A bunch of stuff here to build the SQL String----------
'----------------------------------------------------------------
'Time to connect
calldbconn.ConnectionString = StrCallDB
calldbconn.Open
On Error GoTo CloseConnection
With EmployeeOutput
.ActiveConnection = calldbconn
.Source = SQLString
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
EmpData = .GetRows
On Error GoTo CloseRecordset
End With
'And now, the list box
With lstResults
.Clear
.List = Application.Transpose(EmpData)
End With
'close and reset
CloseRecordset:
EmployeeOutput.Close
CloseConnection:
calldbconn.Close
Set EmployeeOutput = Nothing
Set calldbconn = Nothing
End Sub
I recently coded something for an assignment and I lost marks for not closing a connection and I'm curious about two things. First do ADODB connections for VBA naturally timeout after a few seconds and would I be overwriting the connection for my code included below or would I end up having multiple ADODB connections? In essence, did I do anything wrong by not closing the connections? Thanks.
Option Explicit
'Declaring all necessary variables - Global saves me from redeclaring and allows to be carried
Public dbMyDatabase As String, CnctSource As String, Src As String
Public rstNewQuery As ADODB.Recordset, cntStudConnection As ADODB.Connection
Public Selected1st As String
Private Sub Cancel_Click()
Unload Me
Worksheets("Question3").Range("D4:E9").Clear
End Sub
Private Sub Clear_Click()
Worksheets("Question3Products").Range("C3:H42").Clear
End Sub
Private Sub UserForm_Initialize()
'Get database and links it
dbMyDatabase = ThisWorkbook.Path & "\SalesOrders.mdb"
Set cntStudConnection = New ADODB.Connection
CnctSource = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & dbMyDatabase & ";"
cntStudConnection.Open ConnectionString:=CnctSource
'Commence Query for Categories
Set rstNewQuery = New ADODB.Recordset
rstNewQuery.Open Source:="Categories", ActiveConnection:=cntStudConnection
Range("D4").CopyFromRecordset rstNewQuery
Range("D4:E9").Name = "BufferRange"
TheList.RowSource = "BufferRange"
TheList.Selected(1) = True
'Input Into Listbox
'Decided that clearing the values for connections would be redundant and wasteful.
End Sub
Private Sub FindInfo_Click()
Dim i As Integer
'Switching Sheets and Clearing Previous Variables
Worksheets("Question3Products").Activate
Range("C3:H42").Clear
'Selecting Value user wishes to search for
For i = 0 To TheList.ListCount - 1
If TheList.Selected(i) Then
Selected1st = TheList.List(i)
End If
Next i
'Commence query to search. Decided not to make a function to call upon due to different variables and only 2 instances of use
dbMyDatabase = ThisWorkbook.Path & "\SalesOrders.mdb"
Set cntStudConnection = New ADODB.Connection
CnctSource = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & dbMyDatabase & ";"
cntStudConnection.Open ConnectionString:=CnctSource
Set rstNewQuery = New ADODB.Recordset
Dim StringUse As String
StringUse = "SELECT* From Products WHERE CategoryID = " & Selected1st
rstNewQuery.Open Source:=StringUse, ActiveConnection:=cntStudConnection
Range("C3").CopyFromRecordset rstNewQuery
Range("F3:F42").Style = "Currency"
End Sub
I am trying to update 4 cells in Excel 2010 to my MS Access 2010 using VBA the following code. The problem is that sometimes it update those fields in the table record and other times it is not. I wonder if anyone can shed some light on my code on what is causing to be inconsistent.
'Add a reference to the Microsoft ActiveX Data 2.8 or later Object Library
'via the Tool | References... in the VB-editor
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stDB As String
Dim stCon As String
'Instantiate the ADO COM's objects.
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
'Pathway and name of the database
stDB = "P:\Quote Log.mdb"
'Create the connectionstring.
stCon = "Provider=Microsoft.Ace.OLEDB.12.0; Persist Security Info = False;" & _
"Data Source=" & stDB & ";"
'Open the connection
cnt.Open stCon
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Find and Update the record in Access
With rst
.Index = "PrimaryKey"
.CursorLocation = adUseServer
.Open "tbQuote", cnt, 1, 3, adCmdTableDirect
.Seek Range("dx32").Value
If Not rst.EOF Then
.Fields("QuoteNum") = Sheets("Quote Notice").Range("dx32").Value
.Fields("OtherCost") = Sheets("Cost").Range("b3").Value
.Fields("StocklistCost") = Sheets("Cost").Range("b4").Value
.Fields("DesignHrs") = Sheets("Cost").Range("b5").Value
.Fields("ProductionHrs") = Sheets("Cost").Range("b6").Value
.Update
Else
MsgBox "No such record...not updating."
End If
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Close the recordset and close the connection.
rst.Close
cnt.Close
Set cnt = Nothing
ExitSub:
Set rs = Nothing
'...and set to nothing if no such record
Exit Sub
thank you,
hughv
Okay, discovered my problem...this line needs to reference to the sheet and cell correctly.
.Seek Range("dx32").Value
to:
.seek Worksheet("Quote Notice").range("dx32").Value
I did a query on MS Access 2010, with the Query Builder, now I'm calling it from VBA. But when I try to use the recordcount to know how many records are on this query, the result is -1.
The code:
Public Function teste(Optional ByVal consulta As String, Optional ByVal cbAR_valor As String, Optional ByVal cbAR_valor2 As String)
Dim DB As ADODB.Connection
Dim RST As ADODB.Recordset
Dim Query As ADODB.Command
Dim parametro1 As ADODB.Parameter
Dim parametro2 As ADODB.Parameter
On Error GoTo trataErro
DB_Dir = ThisWorkbook.Path & "\" & "DB2.accdb"
Set DB = New ADODB.Connection
DB.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DB_Dir & ";Persist Security Info=False"
Set Query = New ADODB.Command
Set Query.ActiveConnection = DB
Query.CommandText = consulta
Query.CommandType = adCmdStoredProc
' Pego o valor do param. e adiciono no command
Set parametro1 = Query.CreateParameter("AR1", adChar, adParamInput, 255)
Query.Parameters.Append parametro1
parametro1.Value = cbAR_valor
' Pego o valor do param. e adiciono no command
Set parametro2 = Query.CreateParameter("AR2", adChar, adParamInput, 255)
Query.Parameters.Append parametro2
parametro2.Value = cbAR_valor2
Set RST = Query.Execute
a = RST.RecordCount
linha = 1
coluna = 1
ActiveWorkbook.Sheets("Plan2").Cells(CInt(linha), CInt(coluna)).CopyFromRecordset RST
DB.Close
Set DB = Nothing
Exit Function
trataErro:
MsgBox ("Erro: " & Err.Description)
End Function
RecordCount is tricky. Depending on the provider, data source type, and options, it may not be reliable.
For an ADO recordset, you are more likely to get a reliable RecordCount with a client-side cursor:
Set DB = New ADODB.Connection
DB.CursorLocation = adUseClient '<- add this
DB.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DB_Dir & ";Persist Security Info=False"
I assumed your procedure's consulta argument is a SQL statement. If that is correct, use adCmdText (instead of adCmdStoredProc) for CommandType:
Set Query = New ADODB.Command
'Set Query.ActiveConnection = DB ' Set not needed here ...
Query.ActiveConnection = DB
Query.CommandText = consulta
'Query.CommandType = adCmdStoredProc
Query.CommandType = adCmdText
If those changes were not sufficient to get you a reliable RecordCount, use MoveLast to ensure the recordset is fully populated before asking for RecordCount:
Set RST = Query.Execute
RST.MoveLast
MsgBox "RecordCount: " & RST.RecordCount
Add RST.MoveFirst afterward if you need the recordset pointer to be on the first row in preparation for your remaining operations.
When I've had trouble with counting records before, the issue was with the way the recordset was opened, not the connection. The cursor type needs to be static for it to work. This may be very similar to what HansUp was referring to with the cursorlocation in the connection object, though.
rec.Open querystr, con, 3
rec.movelast
cnt = rec.RecordCount
rec.movefirst
Have the following scenario. I have a few form, which essentially have a few dropboxes, lists etc. I populate them with records from a ms sql db. However, is there a way to query the database only once and store the records as an instance of a class throughout the life of the application rather than querying each time the user opens the form?
Connection is as this:
Sub connection_test()
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim stSQL As String
stSQL = "SELECT * FROM dbo.Client"
Set Cn = New ADODB.Connection
With Cn
.CursorLocation = adUseClient
.Open CONNECTION_STRING
.CommandTimeout = 0
Set Rs = .Execute(stSQL)
End With
Rs.Close
Cn.Close
Set Rs = Nothing
Set Cn = Nothing
End Sub
Can someone suggest a solution for me? I can see all the problems from heavy traffic and mostly unnecessary.
If you just want the recordset available, dim the variable as public in a standard module
Public Rs As ADODB.Recordset
Sub connection_test()
Dim Cn As ADODB.Connection
Dim sSQL As String
If Rs.State = adStateClosed Then
sSQL = "SELECT * FROM dbo.Client"
Set Cn = New ADODB.Connection
With Cn
.CursorLocation = adUseClient
.Open CONNECTION_STRING
.CommandTimeout = 0
Set Rs = .Execute(sSQL)
End With
End If
End Sub
Now Rs will be available anywhere in the project. You can run connection_test whenever you need to and, if the recordset it closed, it will create it. If not, you're good to go.
Generally my approach to this is to create custom classes. I would create a CClient class, fill it from a recordset (or somewhere else), manipulate the objects with the business logic, then write the new values back to the database. That way, none of my business logic relies on the fact that I'm using ado. I could switch to a text file or an Excel worksheet as a data store and wouldn't have to worry about dependencies everywhere in the code.
For instance, suppose I have an Access table:
ClientID, Autonumber
ContactFirst, String
ContactLast, String
Company, String
CityState, String
Volume, Double
I create a CClient class with a property for each field in my table. I also create a CClients class to hold all of the CClient instances. In a standard module, you might have something like this
Public gclsClients As CClients
Sub Main()
Set gclsClients = New CClients
'Fill the class
gclsClients.FillFromRS
'change some value
gclsClients.Client(1).Volume = 100
'write back to the database
gclsClients.WriteToDB
End Sub
Where I change the volume of one client, you would have a lot more code calling your userform, etc. The basics are, load up the class, do whatever you need, then write the class data back to the db. I won't show you all the class code, but in CClients
Public Sub FillFromRS()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim clsClient As CClient
Const sSQL As String = "SELECT * FROM tblClient"
Set cn = New ADODB.Connection
cn.Open msCON
Set rs = cn.Execute(sSQL)
If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF
Set clsClient = New CClient
With clsClient
.ClientID = rs.Fields("ClientID").Value
.ContactFirst = rs.Fields("ContactFirst").Value
.ContactLast = rs.Fields("ContactLast").Value
.Company = rs.Fields("Company").Value
.CityState = rs.Fields("CityState").Value
.Volume = rs.Fields("Volume").Value
End With
Me.Add clsClient
rs.MoveNext
Loop
End If
End Sub
This method gets the data from the database and fills a bunch of CClient instances. Also in CClients
Public Sub WriteToDB()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim clsClient As CClient
Dim sSQL As String
Set cn = New ADODB.Connection
cn.Open msCON
For Each clsClient In Me
sSQL = BuildUpdateSQL(clsClient)
cn.Execute sSQL
Next clsClient
End Sub
Private Function BuildUpdateSQL(clsClient As CClient)
Dim sReturn As String
With clsClient
sReturn = "UPDATE tblClient SET ContactFirst = '" & .ContactFirst & "',"
sReturn = sReturn & " ContactLast = '" & .ContactLast & "',"
sReturn = sReturn & " Company = '" & .Company & "',"
sReturn = sReturn & " CityState = '" & .CityState & "',"
sReturn = sReturn & " Volume = " & .Volume
sReturn = sReturn & " WHERE ClientID = " & .ClientID & ";"
End With
BuildUpdateSQL = sReturn
End Function
This method loops through all of the CClient instances, creates an UPDATE sql statement and executes it. You'll want to implement some sort of IsDirty property in CClient so that you only update those client where something is changed. The rest of CClients and CClient are basic class module stuff.
You can call WriteToDB a lot or a little. In some apps, I write it whenever something changes. In others, I only write back to the database when the workbook is closed. It kind of depends on the flow of your application. The real beauty is that if you change from, say, an Access database to a text file for data storage, you only have to change to methods in CClients. All of the rest of your code consumes CClients and doesn't care where the data lives.
You can see the workbook and Access database here http://www.dailydoseofexcel.com/excel/ClientClassExample.zip
Read up on Disconnected Recordsets here.
One thing that the article does include (in the sample code), but doesn't emphasize is that you have to use the adLockBatchOptimistic. You do not have to use adOpenForwardOnly, as they do. And, of course, your Recordset object has to have a scope outside the sub. I'd do it this way:
Function connection_test() as ADODB.Recordset
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim stSQL As String
stSQL = "SELECT * FROM dbo.Client"
Set Cn = New ADODB.Connection
With Cn
.Open CONNECTION_STRING
.CommandTimeout = 0
End With
With Rs
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.Open stSQL
Set .ActiveConnection = Nothing
End With
Set connection_test = Rs
'DON'T Close the Recordset
'Rs.Close
Cn.Close
'Destroying the local instance is fine, though
Set Rs = Nothing
Set Cn = Nothing
End Function
And of course you want to add error handling ;). Then have a Recordset object declared in the calling code, and instantiate it by calling the Function.