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
Related
I'm trying to run an Access delete query when I close my Excel workbook. I want the DELETE query to delete any record that is prior to today's date in the "ResDate" field. Below is the code I have written. The workbook closes but the records remain in the database (TR table).
I thought this would work but am striking out so far. Any suggestions on getting this to work would be greatly appreciated. Thanks for the help...…….
Const ConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=H:\MyDatabase\TRC.mdb;Persist Security Info=False"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Connection = New ADODB.Connection
Connection.ConnectionString = ConnectionString
Connection.Open
VSQL = "DELETE * FROM [TR] WHERE [TR].ResDate < " & Date
Set RecSet1 = Connection.Execute(VSQL, dbrows, adCmdText)
Connection.Close
Set RecSet1 = Nothing
End Sub
Use the Access Date() function in your SQL statement, instead of inserting the date as text into the statement.
Include Option Explicit in your module's Declarations section and run Debug->Compile from the VB Editor's main menu. Fix the first compile error Access complains about, and then Debug->Compile again. Repeat until no more errors.
Opening a recordset based on a DELETE query is not useful because a DELETE does not return records. Simply execute your query instead.
Const ConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=H:\MyDatabase\TRC.mdb;Persist Security Info=False"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim cn As ADODB.Connection
Dim VSQL As String
Dim dbrows As Long
Set cn = New ADODB.Connection
cn.ConnectionString = ConnectionString
cn.Open
VSQL = "DELETE * FROM [TR] WHERE [TR].ResDate < Date()"
cn.Execute VSQL, dbrows, adCmdText
cn.Close
End Sub
ALWAYS USE PARAMETERS!
When you do VSQL = "DELETE * FROM [TR] WHERE [TR].ResDate < " & Date, depending on your locale, that can result in several issues.
For example, DELETE * FROM [TR] WHERE [TR].ResDate < 2019-11-08, and 2019 minus 11 minus 08 is equal to 2000 and CDate(2000) is 1905-06-22, so this is a valid query, but probably won't delete what you want to delete.
In an alternate locale, it might be 11/08/2019, and 11 divided by 8 divided by 2019 is approximately 0 and CDATE(0) is 1899-12-30.
Instead, pick and choose from How do I use parameters in VBA in the different contexts in Microsoft Access?, for example:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Connection = New ADODB.Connection
Connection.ConnectionString = ConnectionString
Connection.Open
VSQL = "DELETE * FROM [TR] WHERE [TR].ResDate < " & Date
With CreateObject("ADODB.Command")
Set .ActiveConnection = Connection
.CommandText = "DELETE * FROM [TR] WHERE [TR].ResDate < ?"
Set RecSet1 = .Execute(, Array(Date))
End With
Connection.Close
Set RecSet1 = Nothing
End Sub
Right now I am trying to export data from Excel to Access with VBA.
rst("2k2").Value = sProduct
This is an example of what I currently use which is putting the value sProduct into the column in Access called "2k2". How would I move to the next column in Access and put a value in that column? Besides the obvious using the name of that column.
Thanks!
You could set the fields to a variable and cycle through them.
Dim fld as DAO.Field
for each fld in rst.fields
'Do some stuff
next
Disclaimer: As mentioned in the comments, do not use this code in a production environment. Use it only for a DB, which you are using for a school project or anything similar. Databases are really different than an Excel Spreadsheet and the position of the columns is not always constant.
Having said this:
Option Explicit
Public Function GetColumnNameAfter(columnName As String) As String
Dim cnLogs As New ADODB.Connection
Dim rsHeaders As New ADODB.Recordset
Dim rsData As New ADODB.Recordset
Dim myCounter As Long
Dim myConn As String
Dim nameFound As Boolean
myConn = "Provider=SQLNCLI11;Server=(localdb)\MSSQLLocalDB;"
myConn = myConn & "Initial Catalog=Blog;Trusted_Connection=yes;timeout=30;"
cnLogs.Open myConn
With rsHeaders
.ActiveConnection = cnLogs
.Open "SELECT * FROM syscolumns WHERE id=OBJECT_ID('Posts')"
Do While Not rsHeaders.EOF
'Printing is fun...
'Debug.Print rsHeaders(0)
If nameFound Then
GetColumnNameAfter = rsHeaders(0)
Exit Function
End If
If columnName = rsHeaders(0) Then nameFound = True
myCounter = myCounter + 1
rsHeaders.MoveNext
Loop
.Close
End With
End Function
In the strConn change the Initial Catalog to your DB and the DB Table Posts here OBJECT_ID('Posts')" to your DB table. Then the function will return the String name of the column after the the one you have provided as a parameter.
The code loops through the Headers of a table, named "Posts", which is in a DB named Blog. Once it finds a header, named columnName, it sets the nameFound to True and returns the Name of the next column.
Once you know the name of the "Next" column, you can use the same logic as in your question.
I have been looking for a solution to inserting data into excel using vb6 code and access database. There are many cases where I need to write to an excel spreadsheet multiple times with different records of data. I have an existing workbook that I am trying to open and "save as" when I am complete. I have been able to open the excel workbook, access the sheet I am writing to, and the cells I am writing to, however I can only write to the workbook once and when I leave the scope of the open workbook the connection is closed.
I have a sub routine that creates the workbook object, opens the existing workbook and work sheet, writes to a specified cell number to insert the new data. I have looked at official support pages and it doesn't seem to have what I am looking for at this time.
Am I making this too complicated or is there a solution for this? Please help.
My current code:
Row Arrays
Private oldDataRowArray(3 To 21) As Integer
Private updatedDataRowArray(5 To 2) As Integer
Loop logic
Dim i As Integer
Dim n As Integer
i = 3
n = 5
Do While i <= UBound(oldDataRowArray) And n <= UBound(updatedDataRowArray)
EditExcelSheet txtWorkbookFileName.Text, i, n //sub routine
i = i + 3 //skip number of cells
n = n + 3 //skip number of cells
Loop
Sub Routine to Insert data into Excel
Private Sub EditStakingSheet(ByVal workbook As String, ByVal oldDataRowIndex As Integer, ByVal newDataRowIndex As Integer)
Dim objExcel As Object
Dim objWorkBook As Object
Dim objSheet As Object
Set objExcel = New Excel.Application
Set objWorkBook = objExcel.Workbooks.Open(workbook)
Set objSheet = objWorkBook.Worksheets(1)
objExcel.Visible = True
//insert old value
objSheet.Cells(oldDataRowIndex , 26).Value = "old Value"
//insert new value
objSheet.Cells(newDataRowIndex , 26).Value = "new Value"
End Sub
You could use adodb objects.
This video is a good tutorial for this.
Here is an example how you can use adodb. You need to install the activeX Data Objects Libary for this.
For .source= you can use any sql-query.
Public Function get_Value(table As String, order_by As String) As Variant
Set db_data = New ADODB.Recordset
Set db1 = New ADODB.Connection
pDB_path = "#enter db-path here"
db1.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & pDB_path & ";Persist Security Info=False;"
db1.Open
With db_data
.ActiveConnection = db1
.Source = "SELECT * FROM " & table & " ORDER BY " & order_by & " ASC"
.LockType = adLockReadOnly 'read only access to db
.CursorType = adOpenStatic 'how to update the database
.Open
End With
get_Value = TransposeArray(db_data.GetRows)
db_data.Close
End Function
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.
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.