[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Using recordsets and connections

Posted on 2005-05-01
10
Medium Priority
?
393 Views
Last Modified: 2008-01-09
Hi

I have an Access project (.adp) in 2002.

I have form called frmSeizure_Edit and it I have a sub:

Private Sub cmdSaveData_Click()
   
On Error GoTo Err_cmdSaveData_Click
   
    Dim cnnLocal As New ADODB.Connection

    Set cnnLocal = CurrentProject.Connection
    cnnLocal.BeginTrans

    If Me.fsubSeizure.Form.validate = True Then
   
        Call Me.fsubSeizure.Form.update
        DoCmd.Close acForm, "frmSeizure_Edit"
       
    End If
   
    cnnLocal.CommitTrans
    cnnLocal.Close

Exit_cmdSaveData_Click:
   Exit Sub

Err_cmdSaveData_Click:
    cnnLocal.RollbackTrans
    cnnLocal.Close
    MsgBox Err.Description, vbCritical, "System Error"
    Call basGeneral.insertError(Err.Number, Err.Description, Me.Name, "cmdSaveData_Click")
    Resume Exit_cmdSaveData_Click
   
End Sub

The line;
Call Me.fsubSeizure.Form.update

calls a function in a subform which constructs a string and uses the DoCmd.RunSQL method to execute it.

When frmSeizure_Edit opens it populates itself with data and several recordsets are used to do this.  I use a function as follows to create and return a recordset:

Public Function getRecordset(strSource As String, boolConnected As Boolean) As ADODB.Recordset

On Error GoTo Error_Handler
   
    Dim cnnNet  As New ADODB.Connection
    Dim rstCurr As New ADODB.Recordset
       
    Set rstCurr = New ADODB.Recordset
    Set cnnNet = CurrentProject.Connection

    rstCurr.Open strSource, cnnNet, adOpenKeyset, adLockOptimistic
    If boolConnected = False Then
        Set rstCurr.ActiveConnection = Nothing
    End If
    Set getRecordset = rstCurr
    Debug.Print "Just set record set for " & strSource
   
Exit_Error_Handler:
   Exit Function

Error_Handler:
    MsgBox Err.Description, vbCritical, "System Error"
    Call basGeneral.insertError(Err.Number, Err.Description, "basGeneral", "getRecordset")
    Resume Exit_Error_Handler
   
End Function

I use this as follows:

Dim rstRecordset as new ADOB.Recordset
Set rstRecordset = getRecordset("Select * FROM tblSeizure", false)

'do something with recordset

rstRecordset.Close

My problem is that when I call the update function in the subform, and try to requery a list box on another form, the application freezes, and after a while I get a timout error.

It seems to me that the list box cannot be requeried because a table that forms it's source is still locked from some action previous.

If I take out the transaction control in the sub, and therefore have no ADOB.Connection declared and set, the problem is no longer apparent.  It seems to be, my problem is that I may have two connections open to the database at the one time which may be from leaving  a recordset open (without closing it).

I wondered if there was a way in VBA to tell if a recordset is still open, or that a table is locked, or a connection open.  Or if anyone can tell me what the likely cause is to my problem.

Phil
0
Comment
Question by:pmccar06
  • 4
  • 3
  • 3
10 Comments
 
LVL 17

Expert Comment

by:Arji
ID: 13905848
If you religously set your recordsets to Nothing when you close them I think you can tell if they are open or not based on that:

If Recordset = nothing then
   Recordset is closed
else
   Recordset is open
end if

 
0
 
LVL 6

Expert Comment

by:Plamodo
ID: 13910062
Instead of using:
DoCmd.RunSQL sqlStatement

Try using:

CurrentProject.Connection.Execute sqlStatement
0
 

Author Comment

by:pmccar06
ID: 13941517
Sorry guys

No luck with your suggestions.

It seems to be that my problem is that I am implementing transaction control as follows:

    Dim cnnLocal As New ADODB.Connection

    Set cnnLocal = CurrentProject.Connection
    cnnLocal.BeginTrans

    If Me.fsubSeizure.Form.validate = True Then
   
        Call Me.fsubSeizure.Form.update
        DoCmd.Close acForm, "frmSeizure_Edit"
       
    End If
   
    cnnLocal.CommitTrans
    cnnLocal.Close

The statement Call Me.fsubSeizure.Form.update calls a function which itself uses recordsets and the current project connection also - hence my problem.

So it seems to me that you cannot implement transaction control (and therefore use the currentproject.connection) in a function, and in the process call another function that also uses the currentproject.connection.

If this is the case, can anyone tell me a way around this?

Phil
0
Veeam and MySQL: How to Perform Backup & Recovery

MySQL and the MariaDB variant are among the most used databases in Linux environments, and many critical applications support their data on them. Watch this recorded webinar to find out how Veeam Backup & Replication allows you to get consistent backups of MySQL databases.

 
LVL 6

Expert Comment

by:Plamodo
ID: 13942507
I'd be more apt to believe that your timeout is the result of a complex query being computed...
Can you post the query string being constructed?
0
 

Author Comment

by:pmccar06
ID: 13942756
Dear Plamodo

If I comment out the connection object:

Private Sub cmdSaveData_Click()
   
On Error GoTo Err_cmdSaveData_Click
   
    'Dim cnnLocal As New ADODB.Connection

    'Set cnnLocal = CurrentProject.Connection
    'cnnLocal.BeginTrans

    If Me.fsubSeizure.Form.validate = True Then
   
        Call Me.fsubSeizure.Form.update
        DoCmd.Close acForm, "frmSeizure_Edit"
       
    End If

    'cnnLocal.CommitTrans
    'cnnLocal.Close

Exit_cmdSaveData_Click:
   Exit Sub

Err_cmdSaveData_Click:
    'cnnLocal.RollbackTrans
    'cnnLocal.Close
    MsgBox Err.Description, vbCritical, "System Error"
    Call basGeneral.insertError(Err.Number, Err.Description, Me.Name, "cmdSaveData_Click")
    Resume Exit_cmdSaveData_Click
   
End Sub


everything works just fine - in a split second, so query complexity does not seem to be the issue.  The actual function I call is as follows:


Public Function update() As Long

    Dim strSQL                  As String
    Dim strFish_Disposal_Date   As String
    Dim strGear_Disposal_Date   As String
    Dim strSeizure_Date         As String
    Dim lngSeizure_ID           As Long
   
On Error GoTo Err_cmdUpdateData_Click
   
    Call checkForNull
   
    strSeizure_Date = "'" & Format(Me.txtSeizure_Date.Value, "mm/dd/yyyy") & "'"
               
    If Me.fsubsubSeizure.Form!txtFish_Disposal_Date.Value & "" <> "" Then
        strFish_Disposal_Date = "'" & Format(Me.fsubsubSeizure.Form!txtFish_Disposal_Date.Value, "mm/dd/yyyy") & "'"
    Else
        strFish_Disposal_Date = ""
    End If
    If Me.fsubsubSeizure.Form!txtGear_Disposal_Date.Value & "" <> "" Then
        strGear_Disposal_Date = "'" & Format(Me.fsubsubSeizure.Form!txtGear_Disposal_Date.Value, "mm/dd/yyyy") & "'"
    Else
        strGear_Disposal_Date = ""
    End If
   
    strSQL = "UPDATE tblSeizure SET " & _
    "Fish_Disposal_Action = '" & Trim(Replace(Me.fsubsubSeizure.Form!txtFish_Disposal_Action, "'", "")) & "', "
    If Me.fsubsubSeizure.Form!cboFish_Disposal_Authoriser.Value <> "" Then
        strSQL = strSQL & "Fish_Disposal_Authoriser = " & Me.fsubsubSeizure.Form!cboFish_Disposal_Authoriser.Value & ", "
    End If
    If strFish_Disposal_Date <> "" Then
        strSQL = strSQL & "Fish_Disposal_Date = " & strFish_Disposal_Date & ", "
    End If
    If Me.fsubsubSeizure.Form!cboFish_Disposer.Value <> "" Then
        strSQL = strSQL & "Fish_Disposer = " & Me.fsubsubSeizure.Form!cboFish_Disposer & ", "
    End If
    If Me.fsubsubSeizure.Form!cboFish_Held_Office <> "" Then
        strSQL = strSQL & "Fish_Held_Office = " & Me.fsubsubSeizure.Form!cboFish_Held_Office & ", "
    End If
    strSQL = strSQL & "Fish_Disposed = " & basGeneral.getBinaryResult(Me.fsubsubSeizure.Form!chkFish_Disposed) & ", "
    strSQL = strSQL & "Gear_Disposal_Action = '" & Trim(Replace(Me.fsubsubSeizure.Form!txtGear_Disposal_Action, "'", "")) & "', "
    If Me.fsubsubSeizure.Form!cboGear_Disposal_Authoriser.Value <> "" Then
        strSQL = strSQL & "Gear_Disposal_Authoriser = " & Me.fsubsubSeizure.Form!cboGear_Disposal_Authoriser.Value & ", "
    End If
    If strGear_Disposal_Date <> "" Then
        strSQL = strSQL & "Gear_Disposal_Date = " & strGear_Disposal_Date & ", "
    End If
    If Me.fsubsubSeizure.Form!cboGear_Disposer.Value <> "" Then
        strSQL = strSQL & "Gear_Disposer = " & Me.fsubsubSeizure.Form!cboGear_Disposer & ", "
    End If
    If Me.fsubsubSeizure.Form!cboGear_Held_Office <> "" Then
        strSQL = strSQL & "Gear_Held_Office = " & Me.fsubsubSeizure.Form!cboGear_Held_Office & ", "
    End If
    strSQL = strSQL & "Gear_Disposed = " & basGeneral.getBinaryResult(Me.fsubsubSeizure.Form!chkGear_Disposed) & ", " & _
    "Est_Value = " & Me.txtEst_Value.Value & ", " & _
    "Comments = '" & Replace(Me.txtSeizure_Comments.Value, "'", "") & "', " & _
    "Date = " & strSeizure_Date & " " & _
    "WHERE Seizure_ID = " & Me.txtSeizure_ID.Value
   
    DoCmd.RunSQL strSQL

Exit_cmdUpdateData_Click:
   Exit Function

Err_cmdUpdateData_Click:
    MsgBox Err.Description, vbCritical, "System Error"
    Call basGeneral.insertError(Err.Number, Err.Description, Me.Name, "update")
    Resume Exit_cmdUpdateData_Click
End Function

I then simply requery a list box on another form:

Public Function refreshRecent_Seizures()

On Error GoTo Error_Handler
   
    If basLogin.getSGroup_ID = "SFO" Then
        Me.lstDisposalSeizures.RowSource = "SELECT Seizure_ID, Fish, Gear, Date_Seizure, Seizure_Officer FROM qrySeizure_Incident WHERE (((Fish_Held_Zone_ID = " & basLogin.getZone_ID & ") AND (Fish_Disposed = 0)) OR ((Gear_Held_Zone_ID = " & basLogin.getZone_ID & ") AND (Gear_Disposed = 0))) AND (Date_Seizure >= '" & Format(basLogin.getSystem_Release_Date, "mm/dd/yyyy") & "') ORDER BY Date_Seizure DESC"
    Else
        Me.lstDisposalSeizures.RowSource = "SELECT Seizure_ID, Fish, Gear, Date_Seizure, Seizure_Officer FROM qrySeizure_Incident WHERE (((Fish_Held_Office_ID = " & basLogin.getOffice_ID & ") AND (Fish_Disposed = 0)) OR ((Gear_Held_Office_ID = " & basLogin.getOffice_ID & ") AND (Gear_Disposed = 0))) AND (Date_Seizure >= '" & Format(basLogin.getSystem_Release_Date, "mm/dd/yyyy") & "') ORDER BY Date_Seizure DESC"
    End If
    Me.lstDisposalSeizures.Requery
   
Exit_Error_Handler:
   Exit Function

Error_Handler:
    MsgBox Err.Description, vbCritical, "System Error"
    Call basGeneral.insertError(Err.Number, Err.Description, Me.Name, "refreshRecent_Seizures")
    Resume Exit_Error_Handler
   
End Function

Any ideas?

Phil
0
 
LVL 17

Accepted Solution

by:
Arji earned 1000 total points
ID: 13942924
Maybe this will work better than using the inherent connection.  From what I understand this method is better for multiple connections:

Dim strcnnLocal as string
Dim cnnLocal As ADODB.Connection

' Open connection
strcnnLocal = "DRIVER={SQL Server};Server=YourServer;Database=Yourdatabase;Trusted_Connection=Yes;"
Set cnnLocal = New ADODB.Connection
cnnLocal.Open strcnnLocal

0
 
LVL 6

Expert Comment

by:Plamodo
ID: 13945402
Hmm.. I guess my theory doesn't hold much water.  
I'm somewhat surprised because I have many simultaneous connections open that don't seem to ever conflict like that.
0
 
LVL 17

Expert Comment

by:Arji
ID: 13945708
Plamodo,

Don't know if it'll solve the problem.  I was told about this by one of our 'Sages'.  He said that for single connections the inherent connection is fast and works great but if you are planning on having multiple connections, like multiple users, the connection Object is better.  I also found that the {SQL Server} driver only works in MSDE.  I can't get it to work with SQL 2k.  I've had to use the OLEDB driver.  Not sure what to think about that.
0
 

Author Comment

by:pmccar06
ID: 14064672
Arji, looks like you were spot on.  I tried your code, and the problem disappeared.  Sorry about the delay in trying it out, been finishing uni assignments.

Thanks Phil
0
 
LVL 17

Expert Comment

by:Arji
ID: 14068494
Glad it worked!
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…
Suggested Courses
Course of the Month20 days, 12 hours left to enroll

864 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question