Solved

Visual Basic Error Opening 2nd Recordset on ADODB Connection in Microsoft Access

Posted on 2008-06-11
2
331 Views
Last Modified: 2008-06-11
I am trying to open 2 recordsets on the same ADODB connection in Visual Basic code behind a Microsoft access form.  The access database has tables linked to a SQL Server database.  The first recordset opens correctly, however, I get an ODBC connection failed error message (Run-time error '-2147467259 (80004005)') on the second recordset and I'm not sure why.  Code is attached.  Thanks!
Private Sub btnSave_Click()

    Dim dblocal As ADODB.Connection

    Dim rst As ADODB.Recordset

    Dim rstCur As ADODB.Recordset

    Dim stSQL As String

 

    Set dblocal = CurrentProject.Connection

    Set rst = New ADODB.Recordset

    Set rstCur = New ADODB.Recordset

 

 

            stSQL = ""

            stSQL = "SELECT IntSecID FROM tblSecurity WHERE IssuerID = " & txtIssuerID.Value

            rst.Open stSQL, dblocal, adOpenDynamic, adLockOptimistic

            

            If rst.BOF = False Or rst.EOF = False Then

                rst.MoveFirst

            End If

            

            Do While rst.EOF = False

                stSQL = ""

                stSQL = "INSERT INTO tblRatingHistory (StartDate, EndDate, RatingID, RatingSourceID, IntSecID, "

                stSQL = stSQL & "RatingAddedDate, RatingModifiedDate, RatingAddedNTUser, RatingModifiedNTUser) "

                stSQL = stSQL & "VALUES ('" & txtEffDate.Value & "', '9/9/9999', " & cboRating.Value & ", 5, "

                stSQL = stSQL & rst.Fields("IntSecID").Value & ", '" & txtRatingAddedDate.Value & "', '" & txtRatingModifiedDate.Value

                stSQL = stSQL & "', '" & txtRatingAddedNTUser & "', '" & txtRatingModifiedNTUser & "');"

                dblocal.Execute stSQL

                

                '*********************** Update tblRatingCurrent*******************************

                stSQL = ""

                stSQL = "SELECT RatingCurrentID FROM tblRatingCurrent WHERE IntSecID = " & rst.Fields("IntSecID") & " AND RatingTypeID = " & cboRatingType.Value

 

 

 

 

               rstCur.Open stSQL, dblocal, adOpenDynamic, adLockOptimistic    '<---------- Error occurs here

                

                If rstCur.BOF = False Or rstCur.EOF = False Then

                    stSQL = ""

                    stSQL = "UPDATE tblRatingCurrent SET RatingID = " & cboRating.Value & " WHERE RatingCurrentID = " & rstCur.Fields("RatingCurrentID")

                    dblocal.Execute stSQL

                Else

                    stSQL = ""

                    stSQL = "INSERT INTO tblRatingCurrent (IntSecID, RatingTypeID, RatingID) VALUES (" & rst.Fields("IntSecID")

                    stSQL = stSQL & ", " & cboRatingType.Value & ", " & cboRating.Value & ");"

                    dblocal.Execute stSQL

                End If

                

                rstCur.Close

                '******************************************************************************

                

                

                rst.MoveNext

            Loop

            rst.Close

Open in new window

0
Comment
Question by:dskoln
  • 2
2 Comments
 

Author Comment

by:dskoln
ID: 21763164
The same code in the development environment (exact replica of the SQL Server 2000 database, but in SQL Server 2005, same access db and code with access tables linked to dev db instead of the prod db) produces a similar, but slightly different error in the same place.  The error in Dev is:

Run-time error  '-2147467259 (80004005)': Method 'Open' of object '_Recordset' failed
0
 

Accepted Solution

by:
dskoln earned 0 total points
ID: 21764811
found a work around myself that seems to work by associating the 2nd recordset to a different connection variable.

Code is attached below with the changes commented if anyone is interested
Private Sub btnSave_Click()

    Dim dblocal As ADODB.Connection

    Dim dbcur As ADODB.Connection ' <----------- new line

    Dim rst As ADODB.Recordset

    Dim rstCur As ADODB.Recordset

    Dim stSQL As String

 

    Set dblocal = CurrentProject.Connection

    Set rst = New ADODB.Recordset

    Set dbcur = CurrentProject.Connection ' <---------- New line

    Set rstCur = New ADODB.Recordset

 

 

            stSQL = ""

            stSQL = "SELECT IntSecID FROM tblSecurity WHERE IssuerID = " & txtIssuerID.Value

            rst.Open stSQL, dblocal, adOpenDynamic, adLockOptimistic

            

            If rst.BOF = False Or rst.EOF = False Then

                rst.MoveFirst

            End If

            

            Do While rst.EOF = False

                stSQL = ""

                stSQL = "INSERT INTO tblRatingHistory (StartDate, EndDate, RatingID, RatingSourceID, IntSecID, "

                stSQL = stSQL & "RatingAddedDate, RatingModifiedDate, RatingAddedNTUser, RatingModifiedNTUser) "

                stSQL = stSQL & "VALUES ('" & txtEffDate.Value & "', '9/9/9999', " & cboRating.Value & ", 5, "

                stSQL = stSQL & rst.Fields("IntSecID").Value & ", '" & txtRatingAddedDate.Value & "', '" & txtRatingModifiedDate.Value

                stSQL = stSQL & "', '" & txtRatingAddedNTUser & "', '" & txtRatingModifiedNTUser & "');"

                dblocal.Execute stSQL

                

                '*********************** Update tblRatingCurrent*******************************

                stSQL = ""

                stSQL = "SELECT RatingCurrentID FROM tblRatingCurrent WHERE IntSecID = " & rst.Fields("IntSecID") & " AND RatingTypeID = " & cboRatingType.Value

 

 

 

 

               rstCur.Open stSQL, dbcur, adOpenDynamic, adLockOptimistic    '<---------- Updated line, this is where it used to error out

 

 

 

 

 

 

 

                

                If rstCur.BOF = False Or rstCur.EOF = False Then

                    stSQL = ""

                    stSQL = "UPDATE tblRatingCurrent SET RatingID = " & cboRating.Value & " WHERE RatingCurrentID = " & rstCur.Fields("RatingCurrentID")

                    dbcur.Execute stSQL ' <------------- updated line

                Else

                    stSQL = ""

                    stSQL = "INSERT INTO tblRatingCurrent (IntSecID, RatingTypeID, RatingID) VALUES (" & rst.Fields("IntSecID")

                    stSQL = stSQL & ", " & cboRatingType.Value & ", " & cboRating.Value & ");"

                    dbcur.Execute stSQL ' <------------ updated line

                End If

                

                rstCur.Close

                '******************************************************************************

                

                

                rst.MoveNext

            Loop

            rst.Close

 

Open in new window

0

Featured Post

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Question has a verified solution.

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

This article explains how to reset the password of the sa account on a Microsoft SQL Server.  The steps in this article work in SQL 2005, 2008, 2008 R2, 2012, 2014 and 2016.
Ever wondered why sometimes your SQL Server is slow or unresponsive with connections spiking up but by the time you go in, all is well? The following article will show you how to install and configure a SQL job that will send you email alerts includ…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

932 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now