I have a function that needs to check the current database values against the live data. Due to the way the database is set up, I need to run the function recursively, and it creates a new local ADO connection each time then deletes it when its finished. it is definitely slowing down my page. Assuming the SQL command is not the problem, is there a better way to obtain the database record (Faster) without establishing a new ADO record set connection each time?
Here is my code/pseudo sample:
Sub recursiveFunction()
~ run data validation ~
Dim newObjRecordSet As Object = SysGlobals.CreateLocalObject()
newObjRecordSet.Open(SQL_COMMAND,objConn, adOpenStatic ,adLockBatchOptimisti)
Do Until newObjRecordSet.eof
If (some condition) Then
write()
Else
recursiveFunction()
End If
newObjRecordSet.MoveNext()
Loop
SysGlobals.DeleteLocalObject(newObjRecordSet)
End Sub
Here are the global functions:
Public Shared Function CreateLocalObject() As Object
Dim localObj As New Object
localObj = CreateObject("ADODB.Recordset")
localObj.CursorLocation = ADORef.ADOVBS.adUseClient
Return localObj
End Function
Public Shared Sub DeleteLocalObject(ByRef localObj As Object)
If localObj.State() Then localObj.Close()
localObj = Nothing
End Sub
Any inputs would be appreciated!
Related
Short version
I'm entering information in a database and fetching it shortly after, but for some reason, when I enter the information, it isn't immediately entered, so that when I try to fetch it, I get old results. Why does this happen? I thought the operations were synchronous.
Long version
I have a split Access database. At the moment the backend is on my own hard drive to speed up testing, eventually this backend will land on a server. Back when it was a combined frontend/backend database and before I had done a major code refactor (tbh, it was quite the clusterfornication before that), and now this is happening in a number of different scenarios, but pretty much every time I enter information and try to fetch it right after that. Why this happens is a mystery to me, since everything I was reading told me there is no multi-threading in VBA and that everything is synchronous if not specified otherwise, and I haven't enabled any asynchronous options.
Two Examples:
I add a record to the database then refresh the form that contains those new records. I'm not going to post the full code (unless it is deemed necessary), since I've modularized the code a lot. But essentially it boils down to this: the user clicks a button which executes this:
Private Sub Anhang_hinzufügen_Click()
If IsNull(Me.Parent.ID) Then
MsgBox "Bitte erst Felder ausfüllen, und anschließend Anhänge hinzufügen", vbInformation
Else
AnhängeAuswählen Me.Parent.Name, Me.Parent.ID
Me.Form.Requery
End If
End Sub
As part of the AnhängeAuswählen method, the method AddRecord is called:
Function AddRecord(TableName As String, fields() As String, values) As Long
Dim Table As DAO.Recordset
Set Table = LUKSVDB.OpenRecordset(TableName)
Table.AddNew
For i = LBound(fields) To UBound(fields)
If TypeName(Table.fields(fields(i)).Value) = "Recordset2" Then
Dim rs2 As DAO.Recordset2
Set rs2 = Table.fields(fields(i)).Value
If IsArray(values(i)) Then
For j = LBound(values(i)) To UBound(values(i))
rs2.AddNew
rs2!Value = values(i)(j)
rs2.Update
Next j
Else
rs2.AddNew
rs2!Value = values(i)
rs2.Update
End If
Else
Table.fields(fields(i)) = values(i)
End If
Next i
AddRecord = Table!ID
Table.Update
Table.Close
End Function
The record is created, that's not the problem. But when it executes Me.Form.Requery, the new record doesn't appear in the form. Only when I execute Me.Form.Requery a fraction of a second later does the record appear.
I add a record to the database using a form, update some information in the recordset with VBA, then requery the subreport with the records. The record appears immediately, but the details I added programmatically only appear when I execute Me.Parent.Requery a couple of seconds later.
The first form is a data entry form, so that as soon as the data is saved, it's blank in order to create a new record. The previous should then appear in the form. The button to create the new record looks like this:
Private Sub Anmerkung_Hinzufügen_Click()
currentID = Me.ID
mSaved = True
If Me.Dirty Then Me.Dirty = False
UpdateRecord "Anmerkungen", currentID, StringArray("Person", "Datum"), Array(User, Now)
Me.Parent.Requery
End Sub
The UpdateRecord is similar to the AddRecord method:
Function UpdateRecord(TableName As String, ByVal ID As Integer, fields() As String, values)
Dim Table As DAO.Recordset
Set Table = SeekPK(TableName, ID, True)
Table.Edit
For i = LBound(fields) To UBound(fields)
If TypeName(Table.fields(fields(i)).Value) = "Recordset2" Then
Dim subtable As DAO.Recordset2
Set subtable = Table.fields(fields(i)).Value
If IsArray(values(i)) Then
On Error Resume Next
Dim t
t = LBound(values(i))
If Developer Then On Error GoTo -1 Else On Error GoTo Fehler
If Err.Number = 0 Then
For j = LBound(values(i)) To UBound(values(i))
subtable.AddNew
subtable!Value = values(i)(j)
subtable.Update
Next j
End If
Else
subtable.AddNew
subtable!Value = values(i)
subtable.Update
End If
Else
Table.fields(fields(i)) = values(i)
End If
Next i
Table.Update
Table.Close
End Function
Does anyone know why this happens, and how I can prevent it? I could do a bit of a workaround with timers on the forms, so that it refreshes the form a couple of seconds later, but that seems like a kludgy workaround to me, especially considering I don't know how long it specifically takes, and the times could change drastically once the backend is on the server.
Additional information, in case it's necessary:
In the code I've posted I've removed some additional code for error handling and performance logging, but it doesn't have any impact on what's happening otherwise.
When the database is opened, a global variable LUKSVDB As DAO.Database is initialized:
Function ConnectDatabase(Backend As Integer)
Select Case Backend
Case 0: DatenOrt = 'redacted, folder in which the production/beta database is located on the server
Case 1: DatenOrt = 'redacted, folder in which I have a personal testing database on the server
Case 2: DatenOrt = 'redacted, folder in which I have the testing database on my own computer
End Select
Set LUKSVDB = OpenDatabase(DatenOrt & "\LUKS-Verwaltung_be.accdb", False, False, ";pwd=PASSWORD")
End Function
For testing purposes, ConnectDatabase is launched with a value of 2. However, if it's a problem on my own SSD, where latency is just about 0, then I can only assume it will be a problem on the server as well, where the latency is definitely not 0.
I've tried searching the internet for a definitive answer to this two-part scenario but couldn't find anything conclusive. I've been writing VBA procedures for sometime now in both Access and Excel and while trying to streamline some code I came across something of a dilemma
The first part is about using functions to return objects. The example below is generally what I've seen on the web for a function to return an ADODB.Recordset (I've simplified the code so no error handling etc.).
Public Function CreateADORecordset(SQL As String, Connection As ADODB.Connection) As ADODB.Recordset
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
Call rst.Open(SQL, Connection)
Set CreateADORecordset = rst
End Function
The first part of the question is, why do I need a variable called rst when I could rewrite the function as this:
Public Function CreateADORecordset(SQL As String, Connection As ADODB.Connection) As ADODB.Recordset
Set CreateADORecordset = New ADODB.Recordset
Call CreateADORecordset.Open(SQL, Connection)
End Function
Is there anything fundamentally wrong with the above rewrite of the function? As the function returns an ADO recordset, why declare a variable separately?
I can take this a step further:
Public Function CreateADOConnection(ConnectionString As String) As ADODB.Connection
Set CreateADOConnection = New ADODB.Connection
Call CreateADOConnection.Open(ConnectionString)
End Function
Public Function CreateADORecordset(SQL As String, ConnectionString As String) As ADODB.Recordset
Set CreateADORecordset = New ADODB.Recordset
Call CreateADORecordset.Open(SQL, CreateADOConnection(ConnectionString))
End Function
Again, is this a particularly bad thing to do by using function return objects over declaring objects within the procedures via Dim?
In the grand scheme of things, I've been writing VBA code to transfer the contents of a recordset via GetRows into an Excel range. The function declaration line is:
Public Sub TransferRecordsetArray(GetRows As Variant, Destination As Range)
As TransferRecordsetArray works correctly, I've not included the code.
The dilemma I'm in now is in this scenario, I've reached a point where I don't need to declare any variables for the code to run correctly and I'm unsure how much of a good or bad thing this in terms of functions returning objects, scope and variables, etc.
In order to run the code correctly, I only need one of two lines without variables:
Call TransferRecordsetArray(CreateADOConnection(ConnectionString).Execute(SQL).GetRows, Target)
or
Call TransferRecordsetArray(CreateADORecordset(SQL, CreateADOConnection(ConnectionString)).GetRows, Target)
Any advice/recommendations on this way of writing VBA code would be greatly appreciated. I have used the task manager to keep an eye on memory usage on both methods and it doesn't seem to greatly differ and, it appears that VBA destroys the function return objects after a while, despite them not being explicitly destroyed by setting them to Nothing.
Many thanks.
The first part of the question is, why do I need a variable called rst when I could rewrite the function as this
Public Function CreateADORecordset(SQL As String, Connection As ADODB.Connection) As ADODB.Recordset
Set CreateADORecordset = New ADODB.Recordset
Call CreateADORecordset.Open(SQL, Connection)
End Function
You don't need a separate variable. Your code is perfectly fine.
I can take this a step further:
Public Function CreateADOConnection(ConnectionString As String) As ADODB.Connection
Set CreateADOConnection = New ADODB.Connection
Call CreateADOConnection.Open(ConnectionString)
End Function
Public Function CreateADORecordset(SQL As String, ConnectionString As String) As ADODB.Recordset
Set CreateADORecordset = New ADODB.Recordset
Call CreateADORecordset.Open(SQL, CreateADOConnection(ConnectionString))
End Function
Yes, absolutely. Nothing wrong with that.
I've reached a point where I don't need to declare any variables for the code to run correctly
Congratulations, keep it up. :)
Further reading: Is there a need to set Objects to Nothing
There are three separate shared Access databases (tampa1, tampa2, tampa3), multiple users access them. Each user needs to be able to switch databases (using a dropdown list/combo) at any given time, when the user does so. Goal: the program should be able to open the new database in the same instance and close the exiting database (in either order) if it was opened by the same user. I don't want the database to close another instance of any of the three databases opened by different user.
I was able to create the first part of the code, opening the database (although I am not sure if it has been opened in same or different instance). I created a code to close the exiting db (Applicaton.quit), however when I run the code, both databases are closed.
Public Sub Opendb21()
Static acc As Access.Application
Dim db As DAO.Database
Dim strDbName As String
Set acc = New Access.Application
strDbName = "C:\Users\YOURNAME\Documents\Opening multiple db Test\tampa2.accdb"
Set db = acc.DBEngine.OpenDatabase(strDbName, False, False)
acc.OpenCurrentDatabase strDbName
acc.Visible = True
'db.Close
'Set dbRemote = acc.CurrentDb
Set db = Nothing
'Closing the current db tampa1
Forms!Form1.cmd_CloseAccess_Click
End Sub
'Second sub
'Closing cmd -macro converted to VBA code
'This is on Form1, tampa1 database
Public Sub cmd_CloseAccess_Click()
DoCmd.Quit acQuitSaveAll
End Sub
I am expecting the program to close the current db (tampa1); open the second db (tampa2), but the program closes both instead. I need a way to make sure the code doesn't close an instance currently open by different user.
thank you for your hints! I found the solution to the issue by reading another Stack overflow posting, here is the link to that posting:
Access: Shell cmd Open MDB
I was missing the command "Application.UserControl=True" , which makes the application persistent and visible. I created a form which has a combo box that lists the databases I want to switch to. The variable ("OpenWhat")captures the name of the specific database and passes the parameter to a Module Sub, where it then completes the string by adding the rest of the information. After the new database is open, the Form in the first database closes the calling database.
Here is my particular piece of code:
Private Sub cbb_open_otherdb_AfterUpdate()
Dim OpenWhat As String
OpenWhat = Forms!Form1.cbb_open_otherdb.Value
Call Opendb(OpenWhat)
Forms!Form1.cmd_CloseAccess_Click
End Sub
Public Sub cmd_CloseAccess_Click()
On Error GoTo cmd_CloseAccess_Click_Err
DoCmd.Quit acQuitSaveAll
cmd_CloseAccess_Click_Exit:
Exit Sub
cmd_CloseAccess_Click_Err:
MsgBox Error$
Resume cmd_CloseAccess_Click_Exit
End Sub
Option Compare Database
Option Explicit
Public Sub Opendb(ByVal OpenWhat)
Dim objApp As Access.Application
Set objApp = New Access.Application
objApp.UserControl = True
objApp.OpenCurrentDatabase "C:\Users\YOURNAME\Documents\Opening multiple db Test\" + OpenWhat & ".accdb"
MsgBox ("Opening ") & OpenWhat
Debug.Print OpenWhat
Set objApp = Nothing
End Sub
I copied similar code to the other two databases to create a navigation ring.
Thank you for your help!
I am trying to create some custom buttons in Outlook that interact with a table contained within an Access database. So far I have my buttons working in Outlook, running code that instantiates a custom data access class which in turn handles opening and closing the connection to the database. So far as I can tell, this much works.
However from this class I cannot even perform a simple select query. Can anyone help me understand why the code below might not work? I always end out with a recordset that has no rows but if I run the same sql using the Access query designer it works fine.
Public Function GetJobID(ByVal xEmailID As String) As Integer
'Returns the JobID associated with a given EmailID from the email link table.
'Returns a fail constant if no link exists.
Dim rs As ADODB.Recordset
Dim sql As String
'Exit if not connected.
'Cast to boolean because VBA doesn't recognise connection state integer as boolean.
If Not CBool(mConn.State) Then
GetJobID = RESULT_FAIL_INTEGER
Exit Function
End If
sql = "SELECT [JobID] FROM [EMAIL_LINK_TABLE] WHERE [EmailID]='xEmailID'"
sql = Replace(sql, "EMAIL_LINK_TABLE", EMAIL_LINK_TABLE)
sql = Replace(sql, "xEmailID", xEmailID)
On Error Resume Next
Set rs = mConn.Execute(sql)
If rs.RecordCount > 0 Then
GetJobID = rs(1).Value
Else
GetJobID = RESULT_FAIL_INTEGER
End If
End Function
I see you've tracked down the issue to .RecordCount returning -1.
This is standard behavior for dynamic cursors, from the docs:
The cursor type of the Recordset object affects whether the number of records can be determined. The RecordCount property will return -1 for a forward-only cursor; the actual count for a static or keyset cursor; and either -1 or the actual count for a dynamic cursor, depending on the data source.
Of course, you can modify your code to use a static cursor, but that will impact performance. Instead, to test if there are records in your recordset, use .EOF (a method returning a boolean to indicate if the recordset is currently at the end of the file). That will save your code from having to load all records, when only loading the first one is required:
Public Function GetJobID(ByVal xEmailID As String) As Integer
'Returns the JobID associated with a given EmailID from the email link table.
'Returns a fail constant if no link exists.
Dim rs As ADODB.Recordset
Dim sql As String
'Exit if not connected.
'Cast to boolean because VBA doesn't recognise connection state integer as boolean.
If Not CBool(mConn.State) Then
GetJobID = RESULT_FAIL_INTEGER
Exit Function
End If
sql = "SELECT [JobID] FROM [EMAIL_LINK_TABLE] WHERE [EmailID]='xEmailID'"
sql = Replace(sql, "EMAIL_LINK_TABLE", EMAIL_LINK_TABLE)
sql = Replace(sql, "xEmailID", xEmailID)
On Error Resume Next
Set rs = mConn.Execute(sql)
If Not rs.EOF Then
GetJobID = rs(0).Value
Else
GetJobID = RESULT_FAIL_INTEGER
End If
End Function
I have developed a small Excel addin using VBA which connects directly to a database. I set up the connection via a DSN. The addin works wonderfully when opening it and going right at it. However, after a while the connection to the database seems to timeout. More precisely, a perfectly valid query returns an error when trying to open the recordset.
My code is something like this:
'Check Connection
If Not MakeConnectionToDB Then
'Connection failed
[do something]
Exit Function
End If
'Active connection - run the query!
If Rs Is Nothing Then Set Rs = New ADODB.Recordset 'make sure its an active object
If Not Rs.State = adStateClosed Then Rs.Close 'make sure its not full (throws error if a query was called before)
Rs.Open strSQLQuery, CON 'Run query
the rs.open statement fails if the application was open but not used for a while. This is despite the MakeConnectionToDB UDF, which looks something like this:
If Not ConIsActive Then 'If there is no active connection, make it so
If CON Is Nothing Then 'Connection may be inactive because the object dropped, or because it timed out, or any other reason - Only recreate the object if the former is the case
Set CON = New ADODB.Connection
End If
On Error Resume Next
CON.Open strCon 'Try to connect - on error resume statement in order to ignore a connection error, that will be caught below
On Error GoTo 0
Err.Clear
MakeConnectionToDB = ConIsActive 'This is where a connection error will be caught if it occurred
Else
MakeConnectionToDB = True 'connection is active already
End If
and ConIsActive looks like:
Private Function ConIsActive() As Boolean
'return TRUE if there is an active connection, false otherwise
Dim blnTemp As Boolean
blnTemp = False
If (Not (CON Is Nothing)) And (Not (CON = "")) Then If CON.State = adStateOpen Then blnTemp = True
ConIsActive = blnTemp
End Function
Basically, I check if the connection is open. My problem: All these checks return TRUE, but the connection isn't open at all. If I connect, then leave the application for a while, then get back to it, all the above will return that the connection is active, but when trying to open the recordset with a new query it will fail, presumably because the server closed the connection or something. I need to find a way to check if the connection is actually able to open a recordset.
Can I ping the server or something? How can I check if the database actually returns a result to my queries? Is there a way that has a higher performance than just sending a test query to the server combined with error handling on the recordset? I suppose that would work, but I need a high performance solution and I don't think doubling the number of queries for a simple connection check is a superior solution...
Any help is appreciated!
Your CON object seems to be globally-scoped, opened once, and then used everywhere in your code, and possibly closed at some point... or not.
Like every single object in any code base written in any language that supports objects, a database connection should be as short-lived as possible.
You open it, you do what you need to do with it, and then you close it. If you don't know what the next command is going to be executed against it and when, then the connection has no business remaining open.
Delete your global-scope CON. Kill it, with fire. A connection should be local to the function or procedure that uses it - it begins in that scope, and ends in that scope.
Or you can encapsulate it in your own object, if that makes things easier for you.
'#Folder("Data.SqlConnection")
Option Explicit
Private Const CONNECTION_STRING As String = "{CONNECTION STRING}"
Private mConnection As ADODB.Connection
Private Sub Class_Initialize()
Set mConnection = New ADODB.Connection
mConnection.Open
End Sub
Private Sub Class_Terminate()
mConnection.Close
Set mConnection = Nothing
End Sub
Public Sub ExecuteNonQuery(ByVal sql As String, ParamArray params())
With New ADODB.Command
Set .ActiveConnection = mConnection
Dim p As ADODB.Parameter
For Each p In params
.Paramaters.Append p
Next
.Execute
End With
End Sub
'...
An instance of that SqlConnection class should also be as short-lived as possible, but now most of the plumbing is abstracted away so your calling code can look like this:
Const sql As String = "exec dbo.LogUserIn #userName=?, #password=?;"
With New SqlConnection
Dim userName As ADODB.Parameter
Set userName = .CreateStringParameter(Environ$("USERNAME"))
Dim password As ADODB.Parameter
Set password = .CreateStringParameter(PromptForPassword)
.ExecuteNonQuery sql, userName, password
End With
The connection begins at New SqlConnection, cleanly ends at End With, and you can tweak that SqlClass as you need, to support transactions, and/or as illustrated above, to abstract away the parameter-creating boilerplate.
But the idea remains: you don't create a database connection and leave it dangling in global scope, not knowing whether some code somewhere might have set it to Nothing, or closed it, or started a transaction that was never committed, or God knows what.
Create
Open
Execute
Close
Always. As tightly-scoped as possible. Then you won't have any object lifetime issues.