excel vba的多用户登录表单

时间:2017-08-12 21:01:31

标签: excel-vba login vba excel

我已关注this guide并发现如果我的用户名和密码都错误,则会引发运行时错误:

  

“6”溢出错误。

但是,我尝试使用以下代码:

ElseIf Username <> u And Password <> p Then
    MsgBox "Username & Password not matched", vbCritical + vbOKCancel
Exit Do

我尝试使用此代码,但即使我的用户名和密码匹配,它仍会抛出下面的MsgBox。

enter image description here  代码在这里

Private Sub LoginButton_Click()
    Application.ScreenUpdating = False
    Dim Username As String
    Dim Password As String
    Dim i As Integer
    Dim j As Integer
    Dim u As String
    Dim p As String
    If Trim(TextBox1.Text) = "" And Trim(TextBox2.Text) = "" Then
    MsgBox "Enter username and password.", vbOKOnly
    ElseIf Trim(TextBox1.Text) = "" Then
    MsgBox "Enter the username ", vbOKOnly
    ElseIf Trim(TextBox2.Text) = "" Then
    MsgBox "Enter the Password ", vbOKOnly
    Else
    Username = Trim(TextBox1.Text)
    Password = Trim(TextBox2.Text)
    i = 1
    Do While Cells(1, 1).Value <> ""
    j = 1
    u = Cells(i, j).Value
    j = j + 1
    p = Cells(i, j).Value
If Username = u And Password = p And Cells(i, 3).Value = "fail" Then
    MsgBox "Your Account temporarily locked", vbCritical
Exit Do

ElseIf Username = u And Password = p Then
    Call clr
    'LoginFlag = True
    Unload Me
    MsgBox ("Welcome " + u + ", :)")
Exit Do

ElseIf Username <> u And Password = p Then
    MsgBox "Username not matched", vbCritical + vbOKCancel
Exit Do
ElseIf Username = u And Password <> p Then
If Cells(i, 3).Value = "fail" Then
    MsgBox "Your account is blocked", vbCritical + vbOKCancel
Exit Do

ElseIf Cells(i, 4).Value < 2 Then
    MsgBox "Invalid password", vbCritical
    Cells(i, 4).Value = Cells(i, 4) + 1
Exit Do
Else
    Cells(i, 4).Value = Cells(i, 4) + 1
    Cells(i, 3).Value = "fail"
    'Cells(i, 2).Value = ""
    Cells(i, 2).Interior.ColorIndex = 3
Exit Do
End If

ElseIf Username <> u And Password <> p Then
    MsgBox "Username & Password not match", vbCritical + vbOKCancel
Exit Do

Else
    i = i + 1
End If
Loop
End If
    Application.ScreenUpdating = True
End Sub

2 个答案:

答案 0 :(得分:0)

您收到此错误是因为当UsernamePassword都失败时,代码尚未满足,并且它是无限循环Do While Cells(1, 1).Value <> ""。因此,其数据类型设置为i的计数器Integer的值不断增加,一旦超过32,767的限制,它就会生成Overflow错误。

为了支持我的上述断言,请在代码中考虑这些参数:

条件1 - 登录状态为“失败”:

If Username = u And Password = p And Cells(i, 3).Value = "fail" Then

条件2 - UsernamePassword匹配:

ElseIf Username = u And Password = p Then

条件3 - Username不匹配:

ElseIf Username <> u And Password = p Then

条件4 - Password不匹配:

ElseIf Username = u And Password <> p Then

<强>解决方案:

我们需要将无限循环更改为有限,即它一旦到达空白单元格就会停止 - 所以它就像Do While Cells(i, 1).Value <> ""

另外,我们可能会在上面添加UsernamePassword失败的情况,你已经正确识别,但我怀疑,如果它仍然抛出错误,则需要放入在正确的地方,即在Do While循环之后。

另一个小修正 - i应该以2而不是1开头,因为我们想要从2 nd 行进行查找。

因此,让我们把它们放在一起:

Private Sub LoginButton_Click()
    Application.ScreenUpdating = False
    Dim Username As String, Password As String, i As Integer, j As Integer, u As String, p As String
    If Trim(TextBox1.Text) = "" And Trim(TextBox2.Text) = "" Then
        MsgBox "Enter username and password.", vbOKOnly
    ElseIf Trim(TextBox1.Text) = "" Then
        MsgBox "Enter the username ", vbOKOnly
    ElseIf Trim(TextBox2.Text) = "" Then
        MsgBox "Enter the Password ", vbOKOnly
    Else
        Username = Trim(TextBox1.Text)
        Password = Trim(TextBox2.Text)
        i = 2
        Do While Cells(i, 1).Value <> ""
            j = 1
            u = Cells(i, j).Value
            j = j + 1
            p = Cells(i, j).Value
            If Username = u And Password = p And Cells(i, 3).Value = "fail" Then
                MsgBox "Your Account temporarily locked", vbCritical
            Exit Do
            ElseIf Username = u And Password = p Then
                Call clr
                'LoginFlag = True
                Unload Me
                MsgBox ("Welcome " + u + ", :)")
                Exit Do
            ElseIf Username <> u And Password = p Then
                MsgBox "Username not matched", vbCritical + vbOKCancel
                Exit Do
            ElseIf Username = u And Password <> p Then
                If Cells(i, 3).Value = "fail" Then
                    MsgBox "Your account is blocked", vbCritical + vbOKCancel
                    Exit Do
                ElseIf Cells(i, 4).Value < 2 Then
                    MsgBox "Invalid password", vbCritical
                    Cells(i, 4).Value = Cells(i, 4) + 1
                    Exit Do
                Else
                    Cells(i, 4).Value = Cells(i, 4) + 1
                    Cells(i, 3).Value = "fail"
                    'Cells(i, 2).Value = ""
                    Cells(i, 2).Interior.ColorIndex = 3
                    Exit Do
                End If
            Else
                i = i + 1
            End If
        Loop
        If Username <> u And Password <> p Then MsgBox "Username & Password not match", vbCritical + vbOKCancel
    End If
    Application.ScreenUpdating = True
End Sub

请记住,这只是一个演示者。在实践中,消息警报不应该如此清楚地说明错误是用户ID,密码还是两者。

答案 1 :(得分:0)

我相信以下内容可能会更好:

Private Sub LoginButton_Click()
    Application.ScreenUpdating = False
    Dim Username As String
    Dim Password As String
    'Use a variable to flag whether the userid is valid or not
    Dim useridValid As Boolean
    Dim i As Integer
    'Dim j As Integer
    Dim u As String
    Dim p As String
    If Trim(TextBox1.Text) = "" And Trim(TextBox2.Text) = "" Then
        MsgBox "Enter username and password.", vbOKOnly
    ElseIf Trim(TextBox1.Text) = "" Then
        MsgBox "Enter the username ", vbOKOnly
    ElseIf Trim(TextBox2.Text) = "" Then
        MsgBox "Enter the Password ", vbOKOnly
    Else
        Username = Trim(TextBox1.Text)
        Password = Trim(TextBox2.Text)
        useridValid = False
        i = 1
        'Don't perform a loop which is dependent on a fixed cell that
        'isn't updated within the loop
        'Use a variable row counter instead
        'Do While Cells(1, 1).Value <> ""
        Do While Cells(i, 1).Value <> ""
            'There is no point in having a variable simply to specify a
            'column that doesn't change
            'j = 1
            u = Cells(i, "A").Value
            'j = j + 1
            p = Cells(i, "B").Value
            'Only perform tests once a valid username has been found
            If Username = u Then
                'Flag that we have found the userid
                useridValid = True
                If Cells(i, "C").Value = "fail" Then
                    'Too many login attempts
                    MsgBox "Your Account temporarily locked", vbCritical
                ElseIf Password = p Then
                    'Clear invalid attempts count
                    Cells(i, 4).Value = 0
                    Cells(i, 3).Value = ""

                    Call clr
                    Unload Me
                    MsgBox ("Welcome " + u + ", :)")
                Else
                    'Invalid password
                    'Increment failed attempts counter
                    Cells(i, 4).Value = Cells(i, 4) + 1
                    'Lock account on 3rd failed password
                    If Cells(i, 4).Value > 2 Then
                        'lock the account
                        Cells(i, 3).Value = "fail"
                        'Cells(i, 2).Value = ""
                        Cells(i, 2).Interior.ColorIndex = 3
                        'Tell the user that password was invalid and now locked
                        MsgBox "Invalid password - account locked", vbCritical
                    Else
                        'Tell the user that password was invalid
                        MsgBox "Invalid password", vbCritical
                    End If
                End If
                'Don't check any further usernames
                Exit Do
            End If
            i = i + 1
        Loop
        'If the flag saying that we found the userid isn't set, display
        'a message
        If Not useridValid Then
            MsgBox "Username not matched", vbCritical + vbOKCancel
        End If
    End If
    Application.ScreenUpdating = True
End Sub

注意:在工作表中以明文形式保存密码绝对是个坏主意。人们很容易获得整个清单。