添加错误代码

Question

我的表单中有代码，一旦您输入员工ID，它会搜索表格并自动填写相应的数据。如果数字不完整或不在表格中，则会弹出错误窗口

以下是代码：

Me.txtEmpName = rec（＆＃34; EMP_NA＆＃34;）突出显示。我想在不完整ID的情况下，或者如果ID不存在，则会出现一个msg框，说明员工ID无效，请再试一次。或者沿着那些行的东西，然后它只是返回到表单而不是上面的错误消息。有什么想法吗？

Private Sub txtEmpID_AfterUpdate()
Dim db As DAO.Database
Dim rec As DAO.Recordset

Set db = CurrentDb
strSQL = "Select * From tblEmpData Where TMSID = '" & Me.txtEmpID & "'"
Set rec = db.OpenRecordset(strSQL)

Me.txtEmpName = rec("EMP_NA")
Me.cboGender = rec("EMP_SEX_TYP_CD")
Me.cboEEOC = rec("EMP_EOC_GRP_TYP_CD")
Me.txtDivision = rec("DIV_NR")
Me.txtCenter = rec("CTR_NR")
Me.cboRR = rec("REG_NR")
Me.cboDD = rec("DIS_NR")
Me.txtJobD = rec("JOB_CLS_CD_DSC_TE")
Me.cboJobGroupCode = rec("JOB_GRP_CD")
Me.cboFunction = rec("JOB_FUNCTION")
Me.cboMtgReadyLvl = rec("Meeting_Readiness_Rating")
Me.cboMgrReadyLvl = rec("Manager_Readiness_Rating")
Me.cboJobGroup = rec("JOB_GROUP")

Set rec = Nothing
Set db = Nothing
End Sub

Answer 1

打开记录集后，检查它是否为空。如果为空，请显示您的消息。如果不为空，请将记录集值加载到数据控件中。

Set rec = db.OpenRecordset(strSQL)
If (rec.BOF And rec.EOF) Then
    ' when both BOF and EOF are True, the recordset is empty
    MsgBox "employee id is not valid, please try again"
Else
    Me.txtEmpName = rec("EMP_NA")
    ' and so forth
End If

Answer 2

以下代码将解决您遇到的问题。 1.您没有找到记录，因此您收到的错误。 2.如果要处理其他错误，请更改Error_Trap中的代码以测试错误编号。

Private Sub txtEmpID_AfterUpdate()
Dim db As DAO.Database
Dim rec As DAO.Recordset

    On Error GoTo Error_Trap
    Set db = CurrentDb
    strSQL = "Select * From tblEmpData Where TMSID = '" & Me.txtEmpID & "'"
    Set rec = db.OpenRecordset(strSQL)
    If rec.EOF Then
        MsgBox "The Employee ID you entered was not found. Please try again", vbOKOnly, "Wrong ID"
        GoTo Close_It
    End If

    Me.txtEmpName = rec("EMP_NA")
    Me.cboGender = rec("EMP_SEX_TYP_CD")
    Me.cboEEOC = rec("EMP_EOC_GRP_TYP_CD")
    Me.txtDivision = rec("DIV_NR")
    Me.txtCenter = rec("CTR_NR")
    Me.cboRR = rec("REG_NR")
    Me.cboDD = rec("DIS_NR")
    Me.txtJobD = rec("JOB_CLS_CD_DSC_TE")
    Me.cboJobGroupCode = rec("JOB_GRP_CD")
    Me.cboFunction = rec("JOB_FUNCTION")
    Me.cboMtgReadyLvl = rec("Meeting_Readiness_Rating")
    Me.cboMgrReadyLvl = rec("Manager_Readiness_Rating")
    Me.cboJobGroup = rec("JOB_GROUP")

Close_It:
    Set rec = Nothing
    Set db = Nothing
    Exit Sub

Error_Trap:
    If Err.Number = 99999999 Then                       ' Change this line to test for other conditions
        MsgBox "...... ", vbOKOnly, "....."
        Resume Close_It
    End If
End Sub