Vba OpenForm被取消错误再次发生

OpenForm在我的应用程序中再次出现。我已经反编译/压缩并修复了两次

代码抛出错误： '打开菜单窗体 DoCmd.OpenForm“菜单”，acNormal，，acWindowNormal

第一次遇到此错误时，我通过更改以下内容解决了此问题：

DoCmd.OpenForm "Menu", acNormal, "", "", , acNormal

到

这是我遇到异常的过程：

Private Sub Login(recordSet As DAO.recordSet, PERSAL As String, Password As String)
On Error GoTo Login_ErrHandler

'Check to see if the recordset actually contains rows
If Not (recordSet.EOF And recordSet.BOF) Then
    recordSet.MoveFirst 'Unnecessary in this case, but still a good habit

    'See if credentials match data
    Do
        If (recordSet!User_ID = PERSAL And recordSet!Password = Password) Then

           'Open Menu form
            DoCmd.OpenForm "Menu"
           ' Form_Menu.op

            recordSet.Close 'Close the recordset
            Set recordSet = Nothing 'Clean up

            'Close Login form
            DoCmd.Close acForm, "Login"

            Exit Do
        End If

        recordSet.MoveNext

        If (recordSet.EOF Or recordSet.BOF) Then
            MsgBox "Your credentials are incorrect or you are not registered."

            Exit Do
        End If
    Loop

    'Match the values entered for PERSAL nr. and password fields with a row in User table

Else

    MsgBox "There are no records in the recordset."

     recordSet.Close 'Close the recordset
     Set recordSet = Nothing 'Clean up

End If

Form_Login.txtUser_ID.SetFocus

Login_ErrHandler:
If Err = 2501 Then
    'MsgBox "No data to display"
    DoCmd.Hourglass False
    Resume Login_ErrHandler
' Else

 '   MsgBox Err.Description, vbCritical
End If

End Sub

---

这次如何修复此错误？

使用以下SQL创建参数化查询：

PARAMETERS [prmUserId] Text ( 255 ), [prmPassword] Text ( 255 );
SELECT User_ID, Password 
FROM YOUR_TABLE_NAME
WHERE ((([User_ID])=[prmUserId]) AND (([Password])=[prmPassword]));

假设代码位于登录表单后面：

Private Sub Login(ByVal PERSAL As String, ByVal Password As String)
    On Error GoTo Login_ErrHandler

    Dim qdf As DAO.QueryDef
    Set qdf = CurrentDb().QueryDefs("YourQueryName") 'Change to your query name
        qdf.Parameters("[prmUserId]").Value = PERSAL
        qdf.Parameters("[prmPassword]").Value = Password

    Dim rs As DAO.recordSet
    Set rs = qdf.OpenRecordset()

    'No records
    If rs.EOF Then
        MsgBox "Your credentials are incorrect or you are not registered."
        Me.txtUser_ID.SetFocus
        GoTo Leave
    End If

    'User found

    'Close Login Form
    DoCmd.Close acForm, Me.Name, acSavePrompt

    'Open Form
    DoCmd.OpenForm "Menu", acNormal, , , acFormPropertySettings, acWindowNormal

Leave:
    On Error Resume Next
        rs.Close
    Set rs = Nothing
        qdf.Close
    Set qdf = Nothing
    On Error GoTo 0
    Exit Sub

Login_ErrHandler:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume Leave
End Sub

---

问题是什么？您不需要一个循环来检查表中的一行值。菜单是否有任何

OnOpen

或

OnLoad

事件？还要检查它的reocordsource。为什么要传递记录集对象？我想我会用DLookup（）来代替。我是VBA新手，June，所以我的编码不会是一流的。没有听说过DLookup（）。在检查如何查找表行值时，我只找到了recordset对象。recordset对象是因为我在表中循环。Kostas我查找了参数化查询，发现它与我未使用的SQL Server有关。它需要SQL Server吗？这是ms access中的一个简单查询。只需创建查询并粘贴提供的SQL。@Marcus Mackaku不要忘记将“YOUR_TABLE_NAME”更改为表的实际名称。

Private Sub Login(ByVal PERSAL As String, ByVal Password As String)
    On Error GoTo Login_ErrHandler

    Dim qdf As DAO.QueryDef
    Set qdf = CurrentDb().QueryDefs("YourQueryName") 'Change to your query name
        qdf.Parameters("[prmUserId]").Value = PERSAL
        qdf.Parameters("[prmPassword]").Value = Password

    Dim rs As DAO.recordSet
    Set rs = qdf.OpenRecordset()

    'No records
    If rs.EOF Then
        MsgBox "Your credentials are incorrect or you are not registered."
        Me.txtUser_ID.SetFocus
        GoTo Leave
    End If

    'User found

    'Close Login Form
    DoCmd.Close acForm, Me.Name, acSavePrompt

    'Open Form
    DoCmd.OpenForm "Menu", acNormal, , , acFormPropertySettings, acWindowNormal

Leave:
    On Error Resume Next
        rs.Close
    Set rs = Nothing
        qdf.Close
    Set qdf = Nothing
    On Error GoTo 0
    Exit Sub

Login_ErrHandler:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume Leave
End Sub