problem with navigating records in code and updating a record field

gacaccia · Jun 2, 2007

i have an access 2003 adp pointing to a sql server 2000 db. i have a form that displays records using a view as the datasource. there is a "component" combobox that can be used to navigate to a particular record. the application includes a button (labeled "pass") that, if clicked, will set the value for a "status" combobox to a value of "pass" and will then navigate to the next record using docmd.gotorecord,, acnext.

when i first open the form, if i click the "pass" button, things happen as expected. the current record's "status" combobox value changes to "pass" and the form navigates to the next record. however, if i use the navigation combobox to jump to a particular record, suddenly the behavior of the "pass" button changes. now, when i click "pass", the current record's "status" combobox is not updated, though it still navigates to the next record. if i go back one record and click the "pass" button again, then it works as expected!?

behind the scenes, the oddity continues. if i step through the code, here's what happens. after navigation in code occurs, then the first time i click the "pass" button, when the code sets the "status" combobox's value to "pass", it triggers the forms "after update" event. when that happens, the combobox fails to change value. if i go back to the same record and execute the same code, the form's "after update" event does not fire.

any ideas on what is happening here? here is the code that does the navigation...

Code:

Private Sub cbxComponent_AfterUpdate()
    Dim rs As ADODB.Recordset
    
    setSectionSource
    
    If Me.cbxComponent > 0 Then
        Set rs = Me.Recordset
        suppressFormCurrentEvent = True
        rs.MoveFirst
        rs.Find ("componentID = " & Me.cbxComponent)
        Me.cbxSection = Me.sectionID
    End If
End Sub

Private Sub cbxSection_AfterUpdate()
    Dim rs As ADODB.Recordset
    Dim sectionID As Integer
        
    If Me.cbxSection > 0 Then
        sectionID = Me.cbxSection
        Set rs = Me.Recordset
        suppressFormCurrentEvent = True
        rs.MoveFirst
        rs.Find ("sectionID = " & sectionID)
    End If
End Sub

i wouldn't expect someone to look through all of this, but as a reference, here's the entire code for the form...

Code:

Option Compare Database
Option Explicit

'code here needs to be able to handle a number of different work flows when adding an new record.
' 1. adding a new record to test pass only
' 2. adding a new record to test pass and section
' 3. inserting a new record to test pass only
' 4. inserting a new record to test pass and section

'the different between "adding" and "inserting" is how the orderIndex field is populated.
'with "adding", the order index for the new case is simply the next value over current max orderIndex.
'with "inserting", the order index for the new case is the orderIndex value of the next record in the list
'at the time that the INSERT button was clicked.  all test cases above this have their orderIndex value
'incremented one.

'when inserting, the order index must be updated for both the "section" case and the "pass" case.

Dim t1
Dim t2

Dim bm As String

Dim addingRecord As addType
Dim addingLocation As addLocation
Dim nextOrderIndex As Integer
Dim testPassExecutionIDValue As Integer
Dim resetAddingLocation As Boolean

Dim stepsValue As String
Dim summaryValue As String
Dim resultsValue As String
Dim gotoRecord As Integer       'holds target testcaseexecutionid value for navigation purposes
Dim checkNewRecord As Boolean

'use this to bypass code in form_current event when code performs a navigation event
'as opposed to when a user performs a navigation event
Dim suppressFormCurrentEvent As Boolean


Private Sub btnClose_Click()
On Error GoTo Err_btnClose_Click

    DoCmd.Close

Exit_btnClose_Click:
    Exit Sub

Err_btnClose_Click:
    MsgBox Err.description
    Resume Exit_btnClose_Click
End Sub

Private Sub btnCopyLast_Click()
    If Not IsNull(summaryValue) And summaryValue <> "" Then
        Me.tbxSummary = summaryValue
    End If
    If Not IsNull(stepsValue) And stepsValue <> "" Then
        Me.tbxSteps = stepsValue
    End If
    If Not IsNull(resultsValue) And resultsValue <> "" Then
        Me.tbxExpectedResults = resultsValue
    End If

End Sub

Private Sub btnDeleteCase_Click()
    Dim bm
    
    If MsgBox("Delete current test case?  This will remove test case from both the current test pass and the current test project.", vbYesNo, "Delete Confirmation") = vbYes Then
        DoCmd.SetWarnings False
        DoCmd.RunSQL "delete from testCasesExecutions where testCaseExecutionID = " & Me.testCaseExecutionID
        If Me.caseID > 0 Then
            DoCmd.RunSQL "delete from cases where caseID = " & Me.caseID
        End If
        DoCmd.SetWarnings True
        
        bm = Me.Bookmark
        Me.Refresh
        Me.Bookmark = bm
    End If
End Sub

Private Sub btnExecutionHistory_Click()
    DoCmd.OpenForm "testCaseHistory", acNormal, , "caseReferenceCode = " & Me.caseReferenceCode, , acNormal, Me.caseReferenceCode
End Sub

Private Sub btnPass_Click()
    application.Echo False
    Me.cbxStatus = "Pass"
    cbxStatus_AfterUpdate
    btnNext_Click
    application.Echo True
End Sub

Private Sub cbxComponent_AfterUpdate()
    Dim rs As ADODB.Recordset
    
    setSectionSource
    
    If Me.cbxComponent > 0 Then
        Set rs = Me.Recordset
        suppressFormCurrentEvent = True
        rs.MoveFirst
        rs.Find ("componentID = " & Me.cbxComponent)
        Me.cbxSection = Me.sectionID
    End If
End Sub

Private Sub cbxSection_AfterUpdate()
    Dim rs As ADODB.Recordset
    Dim sectionID As Integer
        
    If Me.cbxSection > 0 Then
        sectionID = Me.cbxSection
        Set rs = Me.Recordset
        suppressFormCurrentEvent = True
        rs.MoveFirst
        rs.Find ("sectionID = " & sectionID)
    End If
End Sub

Private Sub cbxStatus_AfterUpdate()
    Dim elapsed As Single
    If (Me.cbxStatus = "Pass" Or Me.cbxStatus = "Fail") And Me.btnTimer.caption = "TIMER ON" Then
        t2 = Timer
        elapsed = Me.tbxElapsedTime + ((t2 - t1) / 60)
        elapsed = Round(elapsed, 2)
        Me.tbxElapsedTime = elapsed
        t1 = Timer
    End If
    
    Select Case Me.cbxStatus
    Case "Fail"
        setSummaryColor "red"
        Me.tbxDateExecuted = Date
    Case "Blocked"
        setSummaryColor "red"
    Case "Pass"
        setSummaryColor "gray"
        Me.tbxDateExecuted = Date
    Case "Skipped"
        setSummaryColor "gray"
    Case "Pending"
        setSummaryColor "white"
    End Select
End Sub

Private Sub btnTimer_Click()
    If Me.btnTimer.caption = "TIMER OFF" Then
        Me.btnTimer.caption = "TIMER ON"
        Me.btnTimer.ForeColor = 255
        Me.btnTimer.FontWeight = 700
        t1 = Timer
    Else
        Me.btnTimer.caption = "TIMER OFF"
        Me.btnTimer.ForeColor = -2147483630
        Me.btnTimer.FontWeight = 400
        t2 = Timer
        Me.tbxElapsedTime = Me.tbxElapsedTime + Round(((t2 - t1) / 60), 2)
    End If
End Sub

Private Sub btnUpdateCase_Click()
    If MsgBox("Are you sure you want to update the current test case?  This will set the " & _
        "test case template to have the same values as the current comments, expected results and priority " & _
        "for this test case pass.", vbYesNo, "Update Test Case?") = vbYes Then
        
        updateCase Me
    End If
End Sub

Private Sub btnInsertTestCase_Click()
    If Me.NewRecord = True Then
        MsgBox "Unable to insert record while creating a new record.", vbExclamation, "Insert Process"
    Else
        DoCmd.gotoRecord , , acNext
        nextOrderIndex = Me.orderIndex
        
        bm = Me.Bookmark
        DoCmd.gotoRecord , , acNewRec
        addingRecord = at_inserting
        
        If addingLocation = al_unspecified Then
            If MsgBox("Add test case to section " & Me.cbxSection.Column(1) & "?", vbYesNo, "Insert Process") = vbYes Then
                addingLocation = al_templateAndSection
            Else
                addingLocation = al_templateOnly
            End If
        End If
    End If
End Sub

Private Sub cbxStatusFilter_AfterUpdate()
    Dim newRowSource As String
    
    If Me.cbxStatusFilter <> "All" Then
        Me.ServerFilter = "status = '" & Me.cbxStatusFilter & "' and testPassExecutionID = " & testPassExecutionIDValue
    Else
        Me.ServerFilter = "testPassExecutionID = " & testPassExecutionIDValue
    End If
    Me.ServerFilterByForm = True
    Me.Refresh
        
    setComponentSource
    setSectionSource
        
End Sub

Private Sub cbxTestPhase_AfterUpdate()
    Me.cbxTestPhase.DefaultValue = Me.cbxTestPhase
End Sub

Private Sub cbxTestType_AfterUpdate()
    Me.cbxTestType.DefaultValue = Me.cbxTestType
End Sub

Private Sub Form_AfterUpdate()
'commented out for now.  need to add check for null values

'    summaryValue = Me.tbxSummary
'    stepsValue = Me.tbxSteps
'    resultsValue = Me.tbxExpectedResults
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
    If addingLocation = al_unspecified Then
        If MsgBox("Add test case to section " & Me.cbxSection.Column(1) & "?", vbYesNo, "Insert Process") = vbYes Then
            addingLocation = al_templateAndSection
        Else
            addingLocation = al_templateOnly
        End If
    End If
End Sub

'for "beforeUpdate", caseID may be null or 0.  it should be null only if this is a new record.  it
'should be 0 only if it has been added or inserted to the test pass only (not added to section also).
Private Sub Form_BeforeUpdate(Cancel As Integer)
    Dim strsql As String
    Dim result
    
    Me.testPassExecutionID = testPassExecutionIDValue
    If Me.NewRecord = True Then
        
    'if inserting a record (meaning the record will be ordered inbetween existing records)...
        If addingRecord = at_inserting Then
            If addingLocation = al_templateAndSection Then
                saveCaseToSection  'this also sets orderIndex for case getting added to section
                updateReferenceCode
'*************************************************************
                'update orderindexes for cases
'*** i don't understand what's happening here, but the below code doesn't appear to be
'       needed as the action it is meant to perform is happening somewhere else ***
                
                'DoCmd.SetWarnings False
                'strSQL = "update cases set orderIndex = orderIndex + 1 where sectionID = " & Me.cbxSection & " and caseID != " & Me.caseID & " and orderIndex >= " & nextOrderIndex
                         
                'DoCmd.RunSQL strSQL
                'DoCmd.SetWarnings True
'**************************************************************
            
            Else
                Me.caseID = 0
            End If
            Me.orderIndex = nextOrderIndex
            'update orderindexes for testcaseexecutions
            DoCmd.SetWarnings False
            strsql = "update testCasesExecutions set orderIndex = orderIndex + 1 where testPassExecutionID = " & Me.testPassExecutionID & " and sectionID = " & Me.cbxSection & " and caseID != " & Me.caseID & " and orderIndex >= " & nextOrderIndex
            DoCmd.RunSQL strsql
            DoCmd.SetWarnings True
        
    'if adding a record (meaning the records will be ordered to end of existing records)...
        Else
            If addingLocation = al_templateAndSection Then
                saveCaseToSection   'this also sets orderIndex for case getting added to section
                updateReferenceCode
            Else
                Me.caseID = 0
            End If
            Me.orderIndex = getNextOrderIndex("testCasesExecutions", "testPassExecutionID", Me.testPassExecutionID, "sectionID", Me.cbxSection)
        End If
        
        Me.componentID = Me.cbxComponent
        Me.sectionID = Me.cbxSection
    End If
    
    If Not IsNull(loginUserID) And Not IsEmpty(loginUserID) Then
        Me.executorID = loginUserID
    End If
End Sub

Private Sub Form_AfterInsert()
    If addingRecord = at_inserting Then
        Me.Refresh
        Me.Bookmark = bm
    End If
    addingRecord = at_unspecified
    If resetAddingLocation = True Then
        addingLocation = al_unspecified
    End If
End Sub

Private Sub saveCaseToSection()
    Dim cs As testCase

    Set cs = New testCase
    
    cs.sectionID = Me.cbxSection
    cs.summary = Me.tbxSummary
    
    If Not IsNull(Me.tbxDescription) Then
        cs.description = Me.tbxDescription
    End If
    If Not IsNull(Me.tbxSteps) Then
        cs.steps = Me.tbxSteps
    End If
    If Not IsNull(Me.tbxExpectedResults) Then
        cs.expectedResults = Me.tbxExpectedResults
    End If
    If Not IsNull(Me.chkNewFeature) Then
        cs.newFeature = Me.chkNewFeature
    End If
    If Not IsNull(Me.cbxTestType) Then
        cs.testType = Me.cbxTestType
    End If
    If Not IsNull(Me.cbxTestPhase) Then
        cs.phase = Me.cbxTestPhase
    End If
    
    If addingRecord = at_inserting Then
        cs.createCase nextOrderIndex
    Else
        cs.createCase 0
    End If
    
    Me.caseID = cs.caseID
End Sub

Private Sub updateReferenceCode()
    Dim strsql As String
    Dim result
    
    strsql = "select referenceCode from sections where sectionID = " & Me.cbxSection
    result = getSingleValue(strsql, "referenceCode")
    Me.sectionReferenceCode = result
    
    strsql = "select referenceCode from cases where caseID = " & Me.caseID
    result = getSingleValue(strsql, "referenceCode")
    Me.caseReferenceCode = result
End Sub


Private Sub Form_Current()
    Dim strsql As String
    Dim count As Double
    Dim totalCount As Double
        
    If suppressFormCurrentEvent = False Then
        If Not IsNull(Me.caseID) Then
            Me.cbxComponent = Me.componentID
            setSectionSource
            Me.cbxSection = Me.sectionID
        End If
        
        Select Case Me.cbxStatus
        Case "Fail", "Blocked"
            setSummaryColor "red"
        Case "Skipped", "Pass"
            setSummaryColor "gray"
        Case "Pending"
            setSummaryColor "white"
        End Select
        
        If Not IsNull(Me.tbxTestPassExecutionID) Then
            strsql = "select count(caseID) as caseCount from testCasesExecutions where testPassExecutionID = " & Me.testPassExecutionID
            totalCount = getSingleValue(strsql, "caseCount")
            Me.lblTotalCases.caption = str(totalCount)
            
            strsql = strsql & " and status = 'Pending'"
            count = getSingleValue(strsql, "caseCount")
            Me.lblTestPassPending.caption = str(count)
            
            count = count / totalCount
            count = count * 100
            count = Round(count, 2)
            count = 100 - count
            Me.lblPercentCompleted.caption = str(count) & "%"
            
            strsql = strsql & " and componentID = " & Me.componentID
            count = getSingleValue(strsql, "caseCount")
            Me.lblComponentPending.caption = str(count)
            
            strsql = strsql & " and sectionID = " & Me.sectionID
            count = getSingleValue(strsql, "caseCount")
            Me.lblSectionPending.caption = str(count)
        End If
        
        If Me.NewRecord = False Then
            If Not IsNull(Me.tbxSummary) Then
                summaryValue = Me.tbxSummary
            Else
                summaryValue = ""
            End If
            If Not IsNull(Me.tbxSteps) Then
                stepsValue = Me.tbxSteps
            Else
                stepsValue = ""
            End If
            If Not IsNull(Me.tbxExpectedResults) Then
                resultsValue = Me.tbxExpectedResults
            Else
                resultsValue = ""
            End If
        End If
    End If
    suppressFormCurrentEvent = False
End Sub

Private Sub Form_Load()
    Dim rs As ADODB.Recordset
    
    If gotoRecord > 0 Then
        Set rs = Me.Recordset
        rs.MoveFirst
        rs.Find ("testCaseExecutionID = " & gotoRecord)
        gotoRecord = 0
    End If
End Sub

Private Sub Form_Open(Cancel As Integer)
    Dim args
    
    Me.ServerFilterByForm = False
    suppressFormCurrentEvent = False
    gotoRecord = 0
    
    'do no allow this form to be opened directly.
    'should only be accessible from test pass dialog or case maintenance dialog
    If IsNull(Me.OpenArgs) Then
        MsgBox "Unable to display form.  Missing test execution ID number.", vbCritical, "Form Open Failure"
        Cancel = True
    Else
        'arg 0: test pass execution id
        'arg 1: test case execution id
        'arg 2: component id
        'arg 3: section id
        
        args = Split(Me.OpenArgs, ",")
        testPassExecutionIDValue = CInt(args(0))
        
        'if there is more than one argument, the form is being opened in one of two ways...
        '1. from the case maintenace dialog after clicking to test an individual case
        '2. without any test cases.  in that situation, a new section is created to
        ' match all test cases entered.  set section and component combo boxes to
        'to show appropriate section/component.  this data is then used for each new "add" or "insert" to
        'update link cases to appropriate section
        
        'in this case, user is testing an individual case.  set gotoRecord in order
        'to navigate to that record after opening form
        If UBound(args) = 1 Then
            gotoRecord = args(1)
            
        'in this case, user is creating a new test pass and adding cases on the fly
        ElseIf UBound(args) > 1 Then
            Me.cbxComponent.DefaultValue = CInt(args(2))
            Me.cbxSection.DefaultValue = CInt(args(3))
            addingLocation = al_templateAndSection
            resetAddingLocation = False
        
        'in this case, dialog has been opened for an existing test pass with existing
        'test cases
        Else
            addingLocation = al_unspecified
            resetAddingLocation = True
        End If
    End If
    Me.cbxComponent.RowSource = "select componentID, componentName from components where componentID in " & _
            "(select componentID from testCasesExecutions where testPassExecutionID = " & testPassExecutionIDValue & ") order by componentName"
    addingRecord = at_unspecified
End Sub

Private Sub setSummaryColor(color As String)
    Select Case color
    Case "red"
        Me.tbxSummary.BackColor = RGB(255, 100, 100)
    Case "gray"
        Me.tbxSummary.BackColor = RGB(200, 200, 200)
    Case "white"
        Me.tbxSummary.BackColor = RGB(255, 255, 255)
    End Select
End Sub
Private Sub btnNext_Click()
On Error GoTo Err_btnNext_Click

    Dim continue As Boolean
    continue = True
    
    If [CurrentRecord] = Me.RecordsetClone.RecordCount Then
        If MsgBox("End of test cases. Do you want to create a new test case?", vbQuestion + vbYesNo, "New Record Confirmation") = vbYes Then
            continue = True
        Else
            continue = False
        End If
    End If
    
    If continue = True Then
        If addingRecord = at_inserting Then
            Me.Bookmark = bm
            DoCmd.gotoRecord , , acNext
        Else
            DoCmd.gotoRecord , , acNext
        End If
    End If
    
Exit_btnNext_Click:
    Exit Sub

Err_btnNext_Click:
    MsgBox Err.description
    Resume Exit_btnNext_Click
    
End Sub
Private Sub btnPrevious_Click()
On Error GoTo Err_btnPrevious_Click

    If addingRecord = at_inserting Then
        Me.Bookmark = bm
        DoCmd.gotoRecord , , acPrevious
    Else
        DoCmd.gotoRecord , , acPrevious
    End If

Exit_btnPrevious_Click:
    Exit Sub

Err_btnPrevious_Click:
    MsgBox Err.description
    Resume Exit_btnPrevious_Click
End Sub
Private Sub btnLast_Click()
On Error GoTo Err_btnLast_Click


    DoCmd.gotoRecord , , acLast

Exit_btnLast_Click:
    Exit Sub

Err_btnLast_Click:
    MsgBox Err.description
    Resume Exit_btnLast_Click
    
End Sub
Private Sub btnFirst_Click()
On Error GoTo Err_btnFirst_Click


    DoCmd.gotoRecord , , acFirst

Exit_btnFirst_Click:
    Exit Sub

Err_btnFirst_Click:
    MsgBox Err.description
    Resume Exit_btnFirst_Click
    
End Sub

Sub setSectionSource()
    Dim newRowSource As String
    Dim statusString As String
    
    If Me.cbxStatusFilter = "All" Then
        statusString = ""
    Else
        statusString = " and status = '" & Me.cbxStatusFilter & "' "
    End If
    
    newRowSource = "select sectionID, sectionName from sections where sectionID in " & _
            "(select sectionID from testCasesExecutions where testPassExecutionID = " & _
            testPassExecutionIDValue & statusString & " and componentID = " & Me.cbxComponent & ") order by sectionName"
    Me.cbxSection.RowSource = newRowSource
    Me.cbxSection.Requery
End Sub

Sub setComponentSource()
    Dim newRowSource As String
    Dim statusString As String
    
    If Me.cbxStatusFilter = "All" Then
        statusString = ""
    Else
        statusString = " and status = '" & Me.cbxStatusFilter & "' "
    End If
    
    newRowSource = "select componentID, componentName from components where componentID in " & _
            "(select componentID from testCasesExecutions where testPassExecutionID = " & _
            testPassExecutionIDValue & statusString & ") order by componentName"
    Me.cbxComponent.RowSource = newRowSource
    Me.cbxComponent.Requery
End Sub

gacaccia · Jun 2, 2007

after a lot of work commenting out most everything and gradually uncommenting code, i found the section that is causing the problem. i have a button for navigating to the next record. if it is the last record, i want the user to get prompted before displaying a "new record". to that end, i used the following code...

Code:

    If [CurrentRecord] = Me.RecordsetClone.RecordCount Then
        If MsgBox("End of test cases. Do you want to create a new test case?", vbQuestion + vbYesNo, "New Record Confirmation") = vbYes Then
            continue = True
        Else
            continue = False
        End If
    End If

if i comment this out, i don't have any problems as described in my first post. any ideas why this is "wrong" and what is a better way to check if you're at the last record?

KevCon · Jun 5, 2007

what constitutes your last record? if it is the highest number of a primary key, then you could compare the existing record's primary key to the highest. you could use a global but let's say you have a hidden text box on the form set to the primary key field, call it Auto1 from a table called tbl_cases

If Me.txt_Auto1 = Dmax("[Auto1]", "tbl_cases") then
...(your prompts)
End if

gacaccia · Jun 21, 2007

sorry for the late reply. there is a primary key, but the records are not sorted by the primary key, so i can't use that to determine if i'm at the last record.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

problem with navigating records in code and updating a record field

gacaccia

Technical User

gacaccia

Technical User

KevCon

Programmer

gacaccia

Technical User

Similar threads

Part and Inventory Search

Sponsor