Issue with Access Data Right after saving (1 Viewer)

[stinger]

How are all friends, I often use MS Access but I am not very good, can you guys help me with this issue, when I save data and access it immediately after some Sometimes the data is accessed properly but sometimes the data is blank,


Private Sub submit_btn_Click()

Dim conn As Object
Dim rs As Object
Dim currentTest As Integer

Dim startTime As Single

disable ' call a sub routine to disable all controls
currentTest = (Nz(DMax("test_fld", "ParametersTbl", "class_fld=" & "'" & Me.class_fld & "'")) + 1)


Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & CurrentProject.FullName

Set rs = CreateObject("ADODB.Recordset")
rs.Open "ParametersTbl", conn, 2, 2
rs.AddNew

rs("class_fld").Value = Me.class_fld
rs("students_fld").Value = Me.students_fld
rs("date_fld").Value = Me.date_fld
rs("time_fld").Value = Me.time_fld
rs("test_fld").Value = currentTest
rs("testCentreMale_fld").Value = Me.testCentreMale_fld
rs("testCentreFemale_fld").Value = Me.testCentreFemale_fld
rs("expiry_fld").Value = Me.expiry_fld


rs.Update
rs.Close
Set rs = Nothing
Set conn = Nothing

startTime = Timer
Do
DoEvents
Loop While Timer < startTime + 3
MsgBox "data saved"


'Me.Refresh
class_fld_Change 'call sub routine combo box change event to retreave data in list box
enable ' sub routine to enable controls on form

End Sub




Private Sub class_fld_Change()

Dim db As dao.Database
Dim rs As dao.Recordset
Dim k As Integer
Dim i As Integer

' clear the list but leave the headers
For i = Me.list_box.ListCount - 1 To 1 Step -1
Me.list_box.RemoveItem i
Next i

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT ParametersTbl.* FROM ParametersTbl WHERE class_fld='" & Forms![Parameters_Form]![class_fld] & "' ORDER BY ParametersTbl.test_fld; ")
k = 1
Do While Not rs.EOF

Me.list_box.AddItem rs!ID & ";" & rs!test_fld & ";" & rs!class_fld & ";" & rs!students_fld & ";" & rs!date_fld & ";" & rs!expiry_fld & ";" & rs!time_fld & ";" & rs!testCentreMale_fld & ";" & rs!testCentreFemale_fld
k = k + 1
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set db = Nothing

End Sub

 

[jdelano]

Why is the code for submit_btn_Click() using a new connection to connect to and write the data? It calls class_fld_Change() so they're in the same database and the latter is using the CurrentDB object to read the data saved from the ParametersTbl. Why not use CurrentDB during the submit_btn code?

 

[stinger]

there is a combo box , when we change the value of combo box we get the data according to that value

 

[stinger]

by default we selected the first value of combo box

 

[stinger]

Can anyone help me with this issue, I will be grateful for your help

 

[jdelano]

Can you post the database?

 

[The_Doc_Man]

For i = Me.list_box.ListCount - 1 To 1 Step -1

Seems to me that this line doesn't see the first line of data in the combo box when you are counting down, because the first line is line 0. Access numbers its collections from 0, not from 1. So in the case where you are trying to see what is in the combo and what you wanted was row 0, you won't see it. Try "For i=Me.list_box.ListCount - 1 to 0 Step -1" maybe.

 

[stinger]

i am attaching my database file , check the WRITE_DATA( ) function in module "dateSetter", after saving the data in this function i immediately open a form "RegSlip_form" and set the record source "SELECT dataTbl.* FROM dataTbl WHERE (((dataTbl.rollint_fld)=[TempVars]![rollint])); "

some time forms come with data and some times blank, when it comes blank after refresh the form data comes

try to save data with class PG, i sett parameters for class PG

 

[stinger]

Seems to me that this line doesn't see the first line of data in the combo box when you are counting down, because the first line is line 0. Access numbers its collections from 0, not from 1. So in the case where you are trying to see what is in the combo and what you wanted was row 0, you won't see it. Try "For i=Me.list_box.ListCount - 1 to 0 Step -1" maybe.

this line is to clear the list box except 1st line because there is header in first line

 

[jdelano]

this line is to clear the list box except 1st line because there is header in first line

Downloaded it, I'll give it a look to see if there is anything that jumps out at me.

EDIT: Give this a try, I just switched it from creating a new connection to instead just using the currentdb object to write the data.

Function WRITE_DATA()
    
    'Dim conn As Object ' ADO Connection Object
    Dim rs As Object   ' ADO Recordset Object
    Dim userResponse As VbMsgBoxResult
    'Dim startTime As Single
    
    
    On Error GoTo ErrorHandler
    
    ' Prompt the user to save
    userResponse = MsgBox("Do you want to save changes?", vbYesNoCancel + vbQuestion, "Save Changes")
    
    If userResponse = vbNo Then
        Exit Function ' If user chooses No, exit the subroutine
    ElseIf userResponse = vbCancel Then
        MsgBox "Transaction canceled."
        Exit Function ' If user chooses Cancel, exit the subroutine
    End If
    
    ' Create ADO connection
    ' 4-16-24 ***********************  Why create a connection to the database you're in?
    'Set conn = CreateObject("ADODB.Connection")
    'conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & CurrentProject.FullName
    
    ' Begin transaction
    ' 4-16-24 the messagebox response makes it so that only a Yes selection makes it this far.
    ' the transaction is not needed
    'conn.BeginTrans
    
    ' Create ADO recordset
    'Set rs = CreateObject("ADODB.Recordset")
    'rs.Open "dataTbl", conn, 2, 2 ' adOpenDynamic, adLockOptimistic
    
    ' 4-16-24 ******************  use the current db object instead of creating an external connection
    Set rs = CurrentDb.OpenRecordset("select * from dataTbl")
    

    
    ' Add a new record to the recordset
    rs.AddNew
    rs("name_fld").Value = TempVars!Name
    rs("gender_fld").Value = TempVars!gender
    rs("father_fld").Value = TempVars!Father
    rs("class_fld").Value = TempVars!Class
    rs("roll_fld").Value = TempVars!Roll
    rs("rollint_fld").Value = TempVars!rollint
    rs("bform_fld").Value = TempVars!Bform
    rs("contact_fld").Value = TempVars!contact
    rs("date_fld").Value = currentDate
    rs("time_fld").Value = currentTime
    rs("testCenter_fld").Value = TempVars!Centre
    rs("dob_fld").Value = TempVars!dob
    rs("sStatus_fld").Value = TempVars!sStatus
    rs("test_fld").Value = TempVars!testCount
    rs("activeStatus_fld").Value = 1
    rs("regTime_fld").Value = Now()
    
  
    rs.Update
    
    ' 4-16-24 **************** as there is an if checking no or cancel before this,
    ' ********* this check here is not neccessary
'    If userResponse = vbYes Then
'        ' Commit transaction
'        conn.CommitTrans
'        Forms!REG_FORM!SUBMIT_BTN.Enabled = False
'
'    Else
'        ' Roll back transaction
'        conn.RollbackTrans
'    End If
    
    ' Clean up
    rs.Close
    'conn.Close
    Set rs = Nothing
    'Set conn = Nothing
    
'       ' Wait for 2 seconds
'    startTime = Timer
'    Do
'        DoEvents
'    Loop While Timer < startTime + 2
'    MsgBox "Data Save Successfully"
    Forms!REG_FORM!SUBMIT_BTN.Enabled = True
    
    Forms!REG_FORM.sStatus = 1  ' set radion button 1 selected i.e fresh
'
' 'clear data from all text fields
'
    Call clearForm
    DoCmd.Close acForm, "RegSlip_form", acSaveYes
    
    DoCmd.OpenForm "RegSlip_form", acNormal
'    MsgBox TempVars!rollint
'    TempVars.RemoveAll

    
    Exit Function ' Exit the subroutine after successful execution
    
ErrorHandler:
    MsgBox "An error occurred. Transaction rolled back."
    conn.RollbackTrans ' Roll back transaction in case of error
    
    ' Clean up
    If Not rs Is Nothing Then
        rs.Close
    End If
    If Not conn Is Nothing Then
        conn.Close
    End If
    Set rs = Nothing
    Set conn = Nothing

  
End Function

 

[stinger]

Downloaded it, I'll give it a look to see if there is anything that jumps out at me.

EDIT: Give this a try, I just switched it from creating a new connection to instead just using the currentdb object to write the data.

Function WRITE_DATA()
   
    'Dim conn As Object ' ADO Connection Object
    Dim rs As Object   ' ADO Recordset Object
    Dim userResponse As VbMsgBoxResult
    'Dim startTime As Single
   
   
    On Error GoTo ErrorHandler
   
    ' Prompt the user to save
    userResponse = MsgBox("Do you want to save changes?", vbYesNoCancel + vbQuestion, "Save Changes")
   
    If userResponse = vbNo Then
        Exit Function ' If user chooses No, exit the subroutine
    ElseIf userResponse = vbCancel Then
        MsgBox "Transaction canceled."
        Exit Function ' If user chooses Cancel, exit the subroutine
    End If
   
    ' Create ADO connection
    ' 4-16-24 ***********************  Why create a connection to the database you're in?
    'Set conn = CreateObject("ADODB.Connection")
    'conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & CurrentProject.FullName
   
    ' Begin transaction
    ' 4-16-24 the messagebox response makes it so that only a Yes selection makes it this far.
    ' the transaction is not needed
    'conn.BeginTrans
   
    ' Create ADO recordset
    'Set rs = CreateObject("ADODB.Recordset")
    'rs.Open "dataTbl", conn, 2, 2 ' adOpenDynamic, adLockOptimistic
   
    ' 4-16-24 ******************  use the current db object instead of creating an external connection
    Set rs = CurrentDb.OpenRecordset("select * from dataTbl")
   

   
    ' Add a new record to the recordset
    rs.AddNew
    rs("name_fld").Value = TempVars!Name
    rs("gender_fld").Value = TempVars!gender
    rs("father_fld").Value = TempVars!Father
    rs("class_fld").Value = TempVars!Class
    rs("roll_fld").Value = TempVars!Roll
    rs("rollint_fld").Value = TempVars!rollint
    rs("bform_fld").Value = TempVars!Bform
    rs("contact_fld").Value = TempVars!contact
    rs("date_fld").Value = currentDate
    rs("time_fld").Value = currentTime
    rs("testCenter_fld").Value = TempVars!Centre
    rs("dob_fld").Value = TempVars!dob
    rs("sStatus_fld").Value = TempVars!sStatus
    rs("test_fld").Value = TempVars!testCount
    rs("activeStatus_fld").Value = 1
    rs("regTime_fld").Value = Now()
   
 
    rs.Update
   
    ' 4-16-24 **************** as there is an if checking no or cancel before this,
    ' ********* this check here is not neccessary
'    If userResponse = vbYes Then
'        ' Commit transaction
'        conn.CommitTrans
'        Forms!REG_FORM!SUBMIT_BTN.Enabled = False
'
'    Else
'        ' Roll back transaction
'        conn.RollbackTrans
'    End If
   
    ' Clean up
    rs.Close
    'conn.Close
    Set rs = Nothing
    'Set conn = Nothing
   
'       ' Wait for 2 seconds
'    startTime = Timer
'    Do
'        DoEvents
'    Loop While Timer < startTime + 2
'    MsgBox "Data Save Successfully"
    Forms!REG_FORM!SUBMIT_BTN.Enabled = True
   
    Forms!REG_FORM.sStatus = 1  ' set radion button 1 selected i.e fresh
'
' 'clear data from all text fields
'
    Call clearForm
    DoCmd.Close acForm, "RegSlip_form", acSaveYes
   
    DoCmd.OpenForm "RegSlip_form", acNormal
'    MsgBox TempVars!rollint
'    TempVars.RemoveAll

   
    Exit Function ' Exit the subroutine after successful execution
   
ErrorHandler:
    MsgBox "An error occurred. Transaction rolled back."
    conn.RollbackTrans ' Roll back transaction in case of error
   
    ' Clean up
    If Not rs Is Nothing Then
        rs.Close
    End If
    If Not conn Is Nothing Then
        conn.Close
    End If
    Set rs = Nothing
    Set conn = Nothing

 
End Function

4-16-24 ****************** use the current db object instead of creating an external connection
Set rs = CurrentDb.OpenRecordset("select * from dataTbl")

I am practicing external connection , coz planning to use on network

 

[jdelano]

Even if the Access database is on a network drive you don't need to use an external connection to connect back to itself.