如何在表中允许记录之前测试多个条件?

时间:2017-04-20 10:15:43

标签: vba ms-access criteria

以下是可以获得的:

  1. 一年有1个会话

  2. 会话中有3个条款

  3. 学生将在学校度过3年。

  4. 学生最多只能在1学期至1年至3年期间注册9个不同的科目。

  5. 学生将被推荐到另一个课程的另一个课程并提供相同的科目。 (我认为需要另一次注册)

  6. 我已经拥有

    1. 我有一个名为tblEnrolled的表,其中记录了注册。

    2. 我有一份报名表格

    3. 在表格中允许记录之前,我想要遵守以下条件:

      1. 没有学生可以在一个学期内注册超过1的特定科目(想要检查所选学生是否已经参加所选科目和所选科目的选定科目)

      2. 没有学生可以在一个学期内注册超过九(9)个不同的科目。

      3. 我真的想要什么?

        我希望SaveButton的On_Click事件检查上述任何标准都没有被违反。

        感谢您的帮助。See the Enrollment Table for a Student, Please

        修改 该代码仅检查主题是否已为特定学生注册。

        Dim NewSubjectCode As String
        Dim NewSubject As String
        Dim stLinkCriteria As String
        Dim strCriteria As String
        Dim strMainCriteria As String
        On Error GoTo Err
        
        If IsNull(cboSession) Then
            MsgBox "Please select SESSION to proceed.", vbInformation, "Required"
            Me.cboSession.SetFocus
            Exit Sub
        End If
        If IsNull(cboTerm) Then
            MsgBox "Please select TERM to proceed.", vbInformation, "Required"
            Me.cboTerm.SetFocus
            Exit Sub
        End If
        If IsNull(cboSelectClass) Then
            MsgBox "Please select CLASS to proceed.", vbInformation, "Required"
            Me.cboSelectClass.SetFocus
            Exit Sub
        End If
        If IsNull(cboName) Then
            MsgBox "Please select STUDENT to proceed.", vbInformation, "Required"
            Me.cboName.SetFocus
            Exit Sub
        End If
        If IsNull(cboCode) Then
            MsgBox "Please select SUBJECT to proceed.", vbInformation, "Required"
            Me.cboCode.SetFocus
            Exit Sub
        End If
        
        NewSubject = Me.txtSubjects.Value
        NewSubjectCode = Me.cboCode.Column(0)
        NewStudentID = Me.txtStudentID.Value
        stLinkCriteria = "[SubjectCode] = " & "'" & NewSubjectCode & "'"
        strCriteria = "[StudentID] = " & "'" & NewStudentID & "'"
        strMainCriteria = stLinkCriteria & "And" & strCriteria
        
        If Me.cboCode.Column(0) = DLookup("[SubjectCode]", "QueryEnrollmentDetails", strMainCriteria) Then
            MsgBox "" & NewSubject & " is already selected for this student.", vbCritical, "Duplicate Subject"
            Me.Undo
            Me.cboCode.SetFocus
            Me.txtStudentID = Me.txtID
            Me.txtStudentName = Me.cboName
            Me.txtStudentClass = Me.txtClass
            Me.txtSession = Me.cboSession
            Me.txtTerm = Me.cboTerm
        Exit Sub
        Else
            DoCmd.RunCommand acCmdSaveRecord
            DoCmd.GoToRecord , , acNewRec
            Me.[SubformSubjects].Requery
            Me.cboCode.SetFocus
            Me.txtStudentID = Me.txtID
            Me.txtStudentName = Me.cboName
            Me.txtStudentClass = Me.txtClass
            Me.txtSession = Me.cboSession
            Me.txtTerm = Me.cboTerm
        End If
        Err:
        Exit Sub
        End Sub
        

        非常感谢@David G

2 个答案:

答案 0 :(得分:1)

您的要求:

  1. 没有学生可以在一个学期内注册超过1个特定科目(想要检查所选学生是否已经参加所选科目和所选科目的选定科目)

  2. 没有学生可以在一个学期内注册超过九(9)个不同的科目。

  3. 可以如下实现(仅限大纲):

    第一个可以作为表的主键来实现,该表记录了为哪个主题输入的内容:Student和Subject的组合是该表的主键,主键根据定义是唯一的。尝试再次插入组合将被数据库拒绝。

    第二个可以实现为"SELECT Count (*) FROM Subjects WHERE student= " & StudentName & "'",然后检查计数小于或等于9.

答案 1 :(得分:0)

谢谢大家。我后来通过使用Multiple Criteria来检查是否存在这样的记录。

“保存”按钮的“单击”事件如下:

Private Sub cmdEnroll_Click()
Dim NewSubjectCode As String
Dim NewSubject As String
Dim strStudent As String
Dim strSubject As String
Dim strTerm As String
Dim strSession As String
Dim strClass As String
Dim StudentCheck As String
Dim SubjectCheck As String
Dim TermCheck As String
Dim SessionCheck As String
Dim SubjectCodeCheck As String
Dim strCriteria As String
Dim ClassCheck As String
On Error GoTo Err

If IsNull(cboSession) Then
    MsgBox "Please select Session to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboSession.SetFocus
    Exit Sub
End If
If IsNull(cboTerm) Then
    MsgBox "Please select Term to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboTerm.SetFocus
    Exit Sub
End If
If IsNull(cboSelectClass) Then
    MsgBox "Please select Class to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboSelectClass.SetFocus
    Exit Sub
End If
If IsNull(cboName) Then
    MsgBox "Please select Student to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboName.SetFocus
    Exit Sub
End If
If IsNull(cboCode) Then
    MsgBox "Please select Subject to proceed.", vbExclamation, "Subjects Enrollment"
    Me.cboCode.SetFocus
    Exit Sub
End If

SubjectCheck = Me.txtSubjects.Value
SubjectCodeCheck = Me.cboCode.Column(0)
StudentCheck = Me.txtStudentID.Value
TermCheck = Me.cboTerm.Value
SessionCheck = Me.cboSession.Value
ClassCheck = Me.cboSelectClass.Value
strSubject = "[SubjectCode] = " & "'" & SubjectCodeCheck & "'"
strStudent = "[StudentID] = " & "'" & StudentCheck & "'"
strTerm = "[Term] = " & "'" & TermCheck & "'"
strSession = "[Session] = " & "'" & SessionCheck & "'"
strClass = "[StudentClass] = " & "'" & ClassCheck & "'"

strCriteria = strStudent & "And" & strSubject & "And" & strTerm & "And" & strSession & "And" & strClass

If IsNull(DLookup("[StudentID]", "QueryEnrollmentDetails", strCriteria)) Then

    CurrentDb.Execute "INSERT INTO tblEnrolled(StudentID,StudentName,StudentClass,SubjectCode,SubjectName,Session,Term) " & _
        " VALUES('" & Me.txtID & "','" & Me.cboName & "','" & Me.cboSelectClass & "','" & _
        Me.cboCode & "','" & Me.txtSubjects & "','" & Me.cboSession & "','" & Me.cboTerm & "')"
    Me.[SubformSubjects].Requery
    Me.cboCode.SetFocus
    Me.txtStudentID = Me.txtID
    Me.txtStudentName = Me.cboName
    Me.txtStudentClass = Me.txtClass
    Me.txtSession = Me.cboSession
    Me.txtTerm = Me.cboTerm
Exit Sub
Else
    MsgBox "" & SubjectCheck & " is already selected for this student.", vbCritical, "Duplicate Subject"
    Me.Undo
    Me.cboCode.SetFocus
    Me.txtStudentID = Me.txtID
    Me.txtStudentName = Me.cboName
    Me.txtStudentClass = Me.txtClass
    Me.txtSession = Me.cboSession
    Me.txtTerm = Me.cboTerm

End If
Exit_Command:
    Exit Sub
Err:
    MsgBox Err.Description, vbCritical, "Error"
    Resume Exit_Command
End Sub