VB6 ADODB strange error behaviour

In the code attached, if the record follows one criteria, a simple update is made and when the recordset.movenext method is called, everything is fine.  However, given the other path, a more complicated update is made and even though the update is properly made, when the recordset.movenext method is called an error is returned:

03/30/2011 3:53:26 PM Row cannot be located for updating. Some values may have been changed since it was last read. :51874.  

Advice, suggestions, appreciated.  It has been a long time since I worked with VB6.






Function ProcessScans() As Boolean
    
    
   Dim rs As Object
   Dim ls_sql As String
   Dim li_reccount As Integer
   Dim li_cntr As Integer
   Dim ls_imgfilename As String
   Dim ls_omisrecord As String
   
   On Error GoTo OOPS
   
   
   ProcessScans = True
   
   
   Set rs = CreateObject("Adodb.Recordset")
      
  
       
'   ls_sql = "SELECT * FROM EMRCONTENT.INDEXDATA WHERE SENTTOOMIS = 'N'"
   
   ls_sql = "SELECT /*+index (INDEXDATA SENTTOOMIS_IDX) */ * FROM EMRCONTENT.INDEXDATA WHERE SENTTOOMIS = 'N'"

   
       
 '   ls_sql = "SELECT * FROM EMRCONTENT.INDEXDATA WHERE UNIQUE_ID = 'OAPS0600002'"
   
  ' ls_sql = "SELECT * FROM EMRCONTENT.INDEXDATA WHERE UNIQUE_ID = 'OAPP0600001'"
       
    rs.Open ls_sql, gs_connection, 2, 3
    
    If rs.EOF Then
        Logit "Nothing to process.  Shutting down."
        Unload Me
        End
    End If
    
    li_reccount = rs.recordcount
    
    
    Dim ls_uniqueid As String
    Dim ls_apptid As String
    Dim startpos As Integer
    Dim str_drno As String
    Dim str_drname As String
    
    
 '   Dim cmdobject As New ADODB.Command
    
    Dim cmdobject As Object
   
    Dim success As Boolean
    
    
    For li_cntr = 1 To li_reccount
       success = True
       Me.RefDrName = ""
       Me.RefDrNo = ""
       
       If rs!source_id = "C1" Or rs!source_id = "C2" Or rs!source_id = "C3" Or rs!source_id = "C4" Then
            
            startpos = InStr(1, rs!Text, "VI:")
           
            If startpos > 0 Then
                ls_apptid = Mid(rs!Text, startpos + 3, 16)
                If GetAffPhysician(ls_apptid, str_drno, str_drname) Then
                    Me.RefDrName = str_drname
                    Me.RefDrNo = str_drno
                End If
            End If
            
       End If
             
             
       ls_omisrecord = AssembleRecord(rs, success)
       
       If Not success Then GoTo skipit
       
       If Not IsNull(ls_omisrecord) Then
          Logit "Sending record to Omis:" + ls_omisrecord
       Else
           Logit "Record " & rs!UNIQUE_ID & " contains one or more null values.  Cannot be sent to OMIS."
           ProcessReject rs!uniqueid, ls_omisrecord
           GoTo skipit
       End If
       
       
       ls_omisrecord = Module1.gs_begchar + ls_omisrecord + Module1.gs_endchar
       
       If SendtoOmis(ls_omisrecord) Then
          ls_uniqueid = rs.fields("UNIQUE_ID")
          
          Logit ("Sending " & ls_uniqueid)
          
          
         ' rs.fields("SENTTOOMIS") = "Y"
         ' rs.fields("DATESENT") = Now()
         ' rs.Update
         
         If Len(Trim(Me.RefDrNo)) > 0 Then
         
            ls_sql = "UPDATE EMRCONTENT.INDEXDATA SET SENTTOOMIS = 'Y',DATESENT = SYSDATE"
            ls_sql = ls_sql + ", REQUESTING_DR_NO = " & Chr(39) & Trim(Me.RefDrNo) & Chr(39)
            ls_sql = ls_sql + ", REQUESTING_DR_NAME = " & Chr(39) & Trim(Me.RefDrName) & Chr(39)
            ls_sql = ls_sql + " WHERE UNIQUE_ID = ?"
         
         Else
         
            ls_sql = "UPDATE EMRCONTENT.INDEXDATA SET SENTTOOMIS = 'Y',DATESENT = SYSDATE WHERE UNIQUE_ID = ?"
         
         End If
         
         
         
         Set cmdobject = CreateObject("ADODB.Command")
         With cmdobject
         
         .CommandText = ls_sql
         .ActiveConnection = gs_connection
         
         
       '  .Parameters.Append .CreateParameter("P1", adVarChar, adParamInput, 64, ls_uniqueid)
         .Parameters.Append .CreateParameter("P1", 200, 1, 64, ls_uniqueid)
                                  
         .Execute
         
         
         End With
         
         Set cmdobject = Nothing
         
        Else
          errhandler rs!UNIQUE_ID & " record was not sent to Omis."
          End
        End If
skipit:
        
        rs.movenext
    Next
        
        
   ' rs.Close
    
    Set rs = Nothing
    Set cmdobject = Nothing
    
        
    Exit Function
    
OOPS:
    
    errhandler Err.Description + " :" + ls_uniqueid
    
    ProcessScans = False
    
    
    
End Function

Open in new window

codefingerAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

inthedarkCommented:
Perhaps you should try this:

Do While Not RS.EOF

Instead of

For li_cntr = 1 To li_reccount



And Atthe End of the loop change:

       rs.movenext
    Next
       

To

       rs.movenext
    Loop
       
0
codefingerAuthor Commented:
inthedark:  I will try that, but I doubt it is going to help.  

More specific info attached:
----------------------------------------

rs.movenext throws the error depending on which of the updates attached is made.
rs is not at EOF in either case.  rs.movenext works under once update scenario, not the other.

I googled the error and found several references, just no definite fix.  It has to do with cursorlocation and adUseServer and batchlocking, I think.
I tried to set it to adUseServer, but that came back with variable not defined.  When I tried using 2 instead   (adUseServer's actual constant value), no records at all are retrieved by the initial select statement.   Same result when I set cursorlocation to 1.




If Len(Trim(Me.RefDrNo)) > 0 Then
         
            ls_sql = "UPDATE EMRCONTENT.INDEXDATA SET SENTTOOMIS = 'Y',DATESENT = SYSDATE"
            ls_sql = ls_sql + ", REQUESTING_DR_NO = " & Chr(39) & Trim(Me.RefDrNo) & Chr(39)
            ls_sql = ls_sql + ", REQUESTING_DR_NAME = " & Chr(39) & Trim(Me.RefDrName) & Chr(39)
            ls_sql = ls_sql + " WHERE UNIQUE_ID = ?"
         
         Else
         
            ls_sql = "UPDATE EMRCONTENT.INDEXDATA SET SENTTOOMIS = 'Y',DATESENT = SYSDATE WHERE UNIQUE_ID = ?"
         
         End If

Open in new window

0
inthedarkCommented:
I presume you are commenting out the   On Error GoTo OOPS so you can tell where the error is.


It is true that when you opened the record set you had x records in it. But unless you open a client side recordset static the records could change.nYou opened with the dymanic option so you will get changes in your rs.

Using "Do While Not RS.eof" instead of a For loop will fix your problem.


Buts also before you select the MoveNext you need to check the status of the RS again.

If RS.EOF Then
    Exit Do
End If
RS.Movenext


Your code would have worked if you had opened a forward only static client side recordset.

But suppose you had a dynamic RS with just one record in it.  You update that one record, so it no longer conforms to the RS selection criteria so the record is removed and you are already automatically moved to the next record and as there is none you go to EOF status.

0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

inthedarkCommented:
Also using forwardonly clientside readonly (static) RS is way faster when using less than a few hundred thousand records.
0
codefingerAuthor Commented:
inthedark:

The revised code is attached.  Did I miss something?  I am still getting exactly the same error.

I removed the commented lines for clarity.


Function ProcessScans() As Boolean
    
    
   Dim rs As Object
   Dim ls_sql As String
   Dim li_reccount As Integer
   Dim li_cntr As Integer
   Dim ls_imgfilename As String
   Dim ls_omisrecord As String
   
   On Error GoTo OOPS
   
   
   ProcessScans = True
   
   
   Set rs = CreateObject("Adodb.Recordset")
      
  
  
       
  
   ls_sql = "SELECT /*+index (INDEXDATA SENTTOOMIS_IDX) */ * FROM EMRCONTENT.INDEXDATA WHERE SENTTOOMIS = 'N'"

   
       
    
  
  
          
    rs.Open ls_sql, gs_connection, 2, 3
    
    If rs.EOF Then
        Logit "Nothing to process.  Shutting down."
        Unload Me
        End
    End If
    
    li_reccount = rs.recordcount
    
    
    Dim ls_uniqueid As String
    Dim ls_apptid As String
    Dim startpos As Integer
    Dim str_drno As String
    Dim str_drname As String
    
    Dim check_appt_id As String
    
    
    
    
     
    Dim cmdobject As Object
   
    Dim success As Boolean
    
    Do While Not rs.EOF
        success = True
       Me.RefDrName = ""
       Me.RefDrNo = ""
       
       If rs!source_id = "C1" Or rs!source_id = "C2" Or rs!source_id = "C3" Or rs!source_id = "C4" Then

            startpos = InStr(1, rs!Text, "VI:")

            If startpos > 0 Then
                check_appt_id = Mid(rs!Text, startpos + 3, 16)
                If GetAffPhysician(check_appt_id, str_drno, str_drname) Then
                    Me.RefDrName = str_drname
                    Me.RefDrNo = str_drno
                End If
            End If

       End If
             
             
       ls_omisrecord = AssembleRecord(rs, success)
       
       If Not success Then GoTo skipit
       
       If Not IsNull(ls_omisrecord) Then
          Logit "Sending record to Omis:" + ls_omisrecord
       Else
           Logit "Record " & rs!UNIQUE_ID & " contains one or more null values.  Cannot be sent to OMIS."
           ProcessReject rs!uniqueid, ls_omisrecord
           GoTo skipit
       End If
       
       
       ls_omisrecord = Module1.gs_begchar + ls_omisrecord + Module1.gs_endchar
       
       If SendtoOmis(ls_omisrecord) Then
          ls_uniqueid = rs.fields("UNIQUE_ID")
          
          Logit ("Sending " & ls_uniqueid)
          
         
         If Len(Trim(Me.RefDrNo)) > 0 Then
         
            ls_sql = "UPDATE EMRCONTENT.INDEXDATA SET SENTTOOMIS = 'Y',DATESENT = SYSDATE"
            ls_sql = ls_sql + ", REQUESTING_DR_NO = " & Chr(39) & Trim(Me.RefDrNo) & Chr(39)
            ls_sql = ls_sql + ", REQUESTING_DR_NAME = " & Chr(39) & Trim(Me.RefDrName) & Chr(39)
            ls_sql = ls_sql + " WHERE UNIQUE_ID = ?"
         
         Else
         
            ls_sql = "UPDATE EMRCONTENT.INDEXDATA SET SENTTOOMIS = 'Y',DATESENT = SYSDATE WHERE UNIQUE_ID = ?"
         
         End If
         
         
         
         Set cmdobject = CreateObject("ADODB.Command")
         With cmdobject
         
         .CommandText = ls_sql
         .ActiveConnection = gs_connection
         
   
         
         
         
         .Parameters.Append .CreateParameter("P1", 200, 1, 64, ls_uniqueid)
                                  
         .Execute
         
         
         End With
         
         Set cmdobject = Nothing
         
        Else
          errhandler rs!UNIQUE_ID & " record was not sent to Omis."
          End
        End If
skipit:
        
        If Not rs.EOF Then
            rs.movenext
        End If
    Loop
    Set rs = Nothing
    Set cmdobject = Nothing
    
        
    Exit Function
    
OOPS:
    
    errhandler Err.Description + " :" + ls_uniqueid
    
    ProcessScans = False
    
    
    
End Function

Open in new window

0
codefingerAuthor Commented:
I should add that this application / code executes on a schedule  (every five minutes) on our server, and normally, that is the ONLY way existing records should be updated.  


0
codefingerAuthor Commented:
I presume you are commenting out the   On Error GoTo OOPS so you can tell where the error is.

No. but that is where it jumps from when I debug.
0
inthedarkCommented:
Here is some code that helps you can use it like this:

If Not IDE Then
    On Error GoTo OOPS
End If

What is the exact error code and message you are getting?


Public Function IDE(Optional Genuine As Boolean) As Boolean

' Returns True if running in debug (IDE) mode
'         False if running in an EXE

'Notes:

' Set LiveMode = True in the declarations to override so test app as EXE

'Example:

' If ADO.IDE Then
'   Stop
' End If

' Also when you realy want to know if in IDE before using function that
' cause IDE to hang
' If Not IDE(True) Then
'   Application.Lock ' Will cuase IDE to hang and need to reboot machine
'   Application("HitCount") = Application("HitCount") + 1
'   Application.UnLock
'Else
'   Application("HitCount") = Application("HitCount") + 1
' End If

If Not Genuine And LiveMode Then
    IDE = False
    Exit Function
End If

Static mIDEDone As Boolean
Static mIDE As Boolean

If Not mIDEDone Then ' See below
    ' just do this first time round then store the result
    On Error Resume Next
    Err.Clear
    Debug.Print 1 / 0; ' THis will cuase error in IDE but is ignored in EXE
    If Err.Number <> 0 Then
        mIDE = True
        Err.Clear
    Else
        mIDE = False
    End If
    mIDEDone = True
End If
IDE = mIDE
End Function

0
codefingerAuthor Commented:
inthedark:

Ok, so now I am completely lost.  I do not see what any of that has to do with the problem we were discussing?   Did you intend that response for another user's question or am I missing something?

The problem happens during debug inside the IDE when recordset.movenext is called.  The error is
"Row cannot be located for updating. Some values may have been changed since it was last read", just as stated in the first post.  The Err.Source is Microsoft Cursor Engine.  The Err.Number is -2147217864. Changing it from a For Loop to a Do While Loop does not fix the problem.

Please advise.

(I appreciate the help.  Please try to be patient with me until I can "get" your answer.)


0
inthedarkCommented:
General Info First.....


1) More info re the IDE function....it speeds up development time because when you a tracing a problem you don't need to step through as you only set the error trap when running in the EXE.

2) When the code arrives at your error place Opps the first thing you must do is redirect the error as you are in danger of creating an error loop; if the ErrHandler sub fails it will keep looping back to Opps.
I suggest to make it look like this:


OOPS:
    ErrN = Err.Number
    ErrD= Err.Description
    On Error Resume Next ' Ensure there will be no error looping
    errhandler ErrD + " :" + ls_uniqueid
   
    ProcessScans = False
   

3) To fix your problem....

As I though the error indicates that the data in your dynamic recordset has changed and so the current record has become invalid. To stop this you need to open the RS readonly, static and location=client.  See the following example function which will open a really fast records in readonly static client location mode. I put all of my handy ADO functions into a class called zADO.

Somewhere in a standard module declarations:

Global ADO as New zADO ' create a link to your handy functions

Use the function like this:

SQL = "Select * from [MyTable];"


' open the readonly recordset
OK = ADO.OpenRSFastROOK(CN, RS, SQL)
If Not OK Then
    Msgbox "Database problem : "+ ADO.ErrD
    exit sub
END If

Do While Not RS.Eof
    ' your process code here

    RS.MoveNext
Loop


Hope this helps ~:}

Public Function OpenRSFastROOK(CN As adodb.Connection, RS As adodb.Recordset, SQL As String, Optional pbDisconnect As Boolean = False) As Boolean

' Open Recordset Readonly returns status true=worked false = failed

Set RS = New adodb.Recordset

If ForceCrash Then
    If IDE Then
        On Error GoTo 0
    Else
        On Error Resume Next
    End If
Else
    On Error Resume Next
End If
Static OK As Boolean

' Check code for SQL injection threats CheckSQLOK
' this is optional and is only need if running on a webserver where hackers may be trying to use SQL Injection threats.

OK = CheckSQLOK(CN, SQL)
If Not OK Then
    Exit Function
End If


Err.Clear
RS.CursorLocation = adUseClient
RS.Open SQL, CN, adOpenStatic + adOpenForwardOnly, adLockReadOnly

If Err.Number <> 0 Then
    ErrN = Err.Number 'public property
    ErrD = Err.Description
    OpenRSFastROOK = False
    Set RS = Nothing
    If IDE Then
        ' paste the error to the clipboard
        GF.Clipper SQL + vbCrLf + vbCrLf + GetLastError(CN) + vbCrLf + Err.Description
        MsgBox Err.Description
        Stop
    End If
Else
    OpenRSFastROOK = True
    If pbDisconnect Then
        RS.ActiveConnection = Nothing
    End If
End If

End Function







0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
codefingerAuthor Commented:
Can you explain what I need to do so my variables such as adUseClient will be defined?
(See my second post).
0
codefingerAuthor Commented:
I was thinking I could not open the recordset read only because I was deliberately changing the value of rs!Requesting_Dr_No in the AssembleRecord Code (not because I really needed to, I was just too lazy to make a new variable) and....DUH!  Shooting my own foot!

So I rewrote the AssembleRecord code to store that value in another variable and leave the recordset alone  --- BINGO!  No more error!  

But I think it is still a good idea to open the recordset the way you described, it will process a little faster.

So when you answer my last question about the variables that should be predefined, we can wrap this up.



0
codefingerAuthor Commented:
I was thinking I could not open the recordset read only because I was deliberately changing the value of one of the columns  in the AssembleRecord Code (not because I really needed to, I was just too lazy to make a new variable) and....DUH!  Shooting my own foot!   Rewrote the code to leave the record set alone.  Also followed advice and opened forward only, readonly, static, etc as suggested, once I realized I needed to add a reference to ADODB Recordsets in the project for variables like adUseClient to be defined.
0
inthedarkCommented:
As I said I created a function in a library to do all ADO functions link opening recordssets, connections etc.

In this way you can write apps that never crash.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.