[RESOLVED] Adding records to mdb database then reloading the combobox doesn't work correctly

[Españolita]

I have a report system for my school and I wanted the user to be able to enter the reports in a datagrid. To do this, for a new term, I add skeleton records for each student in the group, (name, teacher, group, term) and set the other details to 0 or "" accordingly (attendance, speaking, grammar etc)
The code I use to do this is below and it works perfectly well. The problem is that I then want to display that info in the datagrid but the new term is not added to the Term Combobox (where the user selects which term to display and edit) unless I exit the form and go back in (It is a child form) despite the fact I call the very same routine that is called in Form_Load to re-populate the combobox after the new records are added. I have tried for days to see why it does this, I even added the splash screen to give it a little more time to complete adding the records but to no avail. frmSplash.Show simply flashes up a Green tick instead of a messagebox - it makes the user experience a little easier. Can anyone explain why this happens?

Private Sub cmdPrepare_Click()
'Ensure there is a group selected. Style is DropDown List so it must exist if selected
   If cboGroup.ListIndex = -1 Then
      MsgBox "You must select a group", vbExclamation, "Error"
      cboGroup.SetFocus
      Exit Sub
   End If
   
'Ensure there is a month selected. Style is DropDown List so it must exist if selected
   If cboMonth.ListIndex = -1 Then
      MsgBox "You must select a month", vbExclamation, "Error"
      cboMonth.SetFocus
      Exit Sub
   End If
   
'Ensure there is a year selected. Style is DropDown List so it must exist if selected
   If cboYear.ListIndex = -1 Then
      MsgBox "You must select a year", vbExclamation, "Error"
      cboYear.SetFocus
      Exit Sub
   End If
   
'Ensure there is a teacher selected. Style is DropDown List so it must exist if selected
   If cboTeacher.ListIndex = -1 Then
      MsgBox "You must select a teacher", vbExclamation, "Error"
      cboTeacher.SetFocus
      Exit Sub
   End If
   
'make Term Name
   TermName = cboMonth.Text & " " & cboYear.Text
   
'open the database and check for the term name entered. If it already exists, do not proceed
   OpenFile
   sSQL = "SELECT DISTINCT rpID, rpTerm FROM tblReports WHERE rpTerm = """ & TermName & """ ORDER BY rpTerm"
   With rs
      .Open sSQL, cn, adOpenKeyset, adLockPessimistic, adCmdText
      If .RecordCount > 0 Then
         MsgBox "Term " & TermName & " already exists", vbExclamation, "Error"
         cboMonth.SetFocus
         rs.Close
         Exit Sub
      End If
   End With
   rs.Close

'Here, all the error checking has been passed so we can add records to the database and fill the table

'Get students from the selected group
Dim StList As New Collection
Dim st As Variant
   OpenFile
   sSQL = "SELECT DISTINCT stID, stName FROM tblStudent,tblGroup WHERE tblGroup.grName =""" & cboGroup.Text & """ ORDER BY stName"
   With rs
      .Open sSQL, cn, adOpenKeyset, adLockPessimistic, adCmdText
'loop through until EOF
      Do While Not .EOF
'add details to the report table
         StList.Add (.Fields("stID"))
         .MoveNext
      Loop
   End With
   rs.Close
   
Dim GroupID As Long
Dim TeacherID As Long
GroupID = cboGroup.ItemData(cboGroup.ListIndex)
TeacherID = cboTeacher.ItemData(cboTeacher.ListIndex)

Dim adoCommand As ADODB.Command
Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & App.Path & "\Student.mdb;Persist Security Info=False"
    conn.Open
    Set adoCommand = New ADODB.Command
    With adoCommand
        Set .ActiveConnection = conn
        .CommandType = adCmdText
        .CommandText = "INSERT INTO tblReports (rpStudent, rpTeacher, rpTerm, rpGroup, rpParticipation, rpBehaviour, rpSpeaking, rpListening, rpGrammar, rpWriting, rpAttendance, rpComments) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
        .Prepared = True
        .Parameters.Append .CreateParameter("std", adDouble, adParamInput) 'student ptr
        .Parameters.Append .CreateParameter("tch", adDouble, adParamInput) 'teacher ptr
        .Parameters.Append .CreateParameter("trm", adVarChar, adParamInput, 20) 'Term Name
        .Parameters.Append .CreateParameter("grp", adDouble, adParamInput) 'group ptr
        .Parameters.Append .CreateParameter("part", adInteger, adParamInput)  'participation
        .Parameters.Append .CreateParameter("beh", adInteger, adParamInput)  'behaviour
        .Parameters.Append .CreateParameter("spk", adInteger, adParamInput)  'speaking
        .Parameters.Append .CreateParameter("lst", adInteger, adParamInput)  'listening
        .Parameters.Append .CreateParameter("grm", adInteger, adParamInput)  'grammar
        .Parameters.Append .CreateParameter("wrt", adInteger, adParamInput)  'writing
        .Parameters.Append .CreateParameter("att", adVarChar, adParamInput, 10) 'attendance
        .Parameters.Append .CreateParameter("com", adVarChar, adParamInput, 200) 'Comments
        For Each st In StList
            .Parameters("std").Value = st
            .Parameters("tch").Value = TeacherID
            .Parameters("trm").Value = TermName
            .Parameters("grp").Value = GroupID
            .Parameters("part").Value = 0
            .Parameters("beh").Value = 0
            .Parameters("spk").Value = 0
            .Parameters("lst").Value = 0
            .Parameters("grm").Value = 0
            .Parameters("wrt").Value = 0
            .Parameters("att").Value = ""
            .Parameters("com").Value = ""
            .Execute , , adCmdText + adExecuteNoRecords
        Next st
    End With
    Set adoCommand = Nothing
're-populate the combobox
   frmSplash.Show vbModal
   FillTermCombo

End Sub

Private Sub FillTermCombo()
Dim sSQL As String
    cboTerm.Clear
    OpenFile
    sSQL = "SELECT DISTINCT rpTerm FROM tblReports ORDER BY rpTerm"
    With rs
        .Open sSQL, cn, adOpenKeyset, adLockPessimistic, adCmdText
'loop through until EOF
        Do While Not .EOF
            cboTerm.AddItem .Fields("rpTerm")
            .MoveNext
        Loop
    End With
    rs.Close
End Sub

[dw85745]

I'll offer two possiblities:

1) Position Cursor to top of Recordset before you begin your loop

Private Sub FillTermCombo()
Dim sSQL As String
    cboTerm.Clear
    OpenFile
    sSQL = "SELECT DISTINCT rpTerm FROM tblReports ORDER BY rpTerm"
    With rs
        .Open sSQL, cn, adOpenKeyset, adLockPessimistic, adCmdText
'loop through until EOF

        .MoveFirst                           '<<  Add this line
        Do While Not .EOF
            cboTerm.AddItem .Fields("rpTerm")
            .MoveNext
        Loop
    End With
    rs.Close
End Sub

2) Try compacting the DB before you reload. I've found AccessDB at time require this for some reason!!!!

[dw85745]

deleted

[Españolita]

Thank you for your reply dw. Unfortunately, I tried both suggestions and neither made any difference. Ir still doesn't update the combobox until I close the form and reopen it

[gibra]

After INSERT or UPDATE need to refresh the cache:
http://www.xtremevbtalk.com/showthread.php?t=102739#5

[Españolita]

Thank you gibra, that solved it.