?
Solved

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

Posted on 2008-06-11
2
Medium Priority
?
349 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Access custom database properties are useful for storing miscellaneous bits of information in a format that persists through database closing and reopening.  This article shows how to create and use them.
In part one, we reviewed the prerequisites required for installing SQL Server vNext. In this part we will explore how to install Microsoft's SQL Server on Ubuntu 16.04.
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…
Viewers will learn how to use the UPDATE and DELETE statements to change or remove existing data from their tables. Make a table: Update a specific column given a specific row using the UPDATE statement: Remove a set of values using the DELETE s…
Suggested Courses

770 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