尝试避免 BeforeUpdate 时出现运行时错误 2115

Question

我在数据输入表单上有以下代码，其中还包括未绑定的搜索框。当用户搜索没有匹配项的内容时（即，当 recordset.Recordcount = 0 时），表单错误至 2115 并崩溃。

`    Private Sub Form_BeforeUpdate(Cancel As Integer)
     ' This procedure checks to see if the data on the form has
     ' changed. If the data has changed, the procedure prompts the
     ' user to continue with the save operation or to cancel it. Then
     ' the action that triggered the BeforeUpdate event is completed.

     Dim ctl As Control

     On Error GoTo Err_BeforeUpdate

     ' The Dirty property is True if the record has been changed.
     If Me.Dirty Then
       ' Prompt to confirm the save operation.
       If MsgBox("Do you want to save?", vbYesNo + vbQuestion, _
           "Save Record") = vbNo Then
        Me.Undo
       End If
     End If

    Exit_BeforeUpdate:
     Exit Sub

    Err_BeforeUpdate:
     If DataErr = 2115 Then
      Response = acDataErrContinue
      Me.cboSearch.Text = ""
      Cancel = True
      Me.cboSearch.Undo
      ExitSub
     Else
    MsgBox Err.Number & " " & Err.Description
    Resume Exit_BeforeUpdate
     End If
 
    End Sub`

以下是未绑定搜索框的代码：

`    Private Sub cboSearch_AfterUpdate()
        Dim strFilter As String
        Dim sSearch As String
        On Error Resume Next

        If Me.cboSearch.Text <> "" Then
            sSearch = "'*" & Replace(Me.cboSearch.Text, "'", "''") & "*'"
            strFilter = "SalesOrder Like " & sSearch & " OR PO Like " & sSearch &_
            " OR PONotes Like " &      sSearch & " OR ProjectPlan Like " & sSearch
        Me.Filter = strFilter
        Me.FilterOn = True
        DoCmd.SetWarnings False
    Else
        Me.Filter = ""
        Me.FilterOn = False
    End If
        DoCmd.SetWarnings True
    If Me.Recordset.RecordCount = 0 Then 'new line of code
        MsgBox "There are no records for this search."
        Me.Filter = "" 'new line of code
        Me.FilterOn = False 'new line of code
        Me.cboSearch.SetFocus 'new line of code
        Me.cboSearch.Text = "" 'new line of code
    Exit Sub 'new line of code
    End If 'new line of code

    With Me.cboSearch
        .SetFocus
        .SelStart = Len(Me.cboSearch.Text)
    End With
    End Sub`

尝试了我发现的一些帖子中的一些不同建议，但没有任何效果。尝试了解与未绑定控件相关的 BeforeUpdate 事件的逻辑。

Answer 1

您的错误处理例程中有一个拼写错误。您的代码将

ExitSub

显示为一个单词，而不是

Exit Sub

作为两个单词。

您还可以按照如下方式编写错误处理程序代码：

    Err_BeforeUpdate:
     If DataErr = 2115 Then
      Response = acDataErrContinue
      Me.cboSearch.Text = ""
      Cancel = True
      Me.cboSearch.Undo
     Else
      MsgBox Err.Number & " " & Err.Description
     End If
    Resume Exit_BeforeUpdate