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?
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?
Code:
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 SubCode:
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