vba excel vba的多用户登录表单

Multiple User login form for excel vba

提问by Xen

I have followed this guideand found out that if my username and password is both wrong, it will throw a runtime error:

我遵循了本指南，发现如果我的用户名和密码都错误，则会引发运行时错误：

"6" Overflow error.

“6”溢出错误。

However, I have tried using the code below:

但是，我尝试使用以下代码：

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

I tried using this code but even if my username and password match it still throw the below MsgBox.

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

Code 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

回答by curious

You are getting this error because the code hasn't been catered for the case when both Usernameas well as Passwordfail, and it's an infinite loop Do While Cells(1, 1).Value <> "". So the value of counter i, whose data type is set as Integer, keeps increasing, and once it exceeds the limit of 32,767, it generates the Overflowerror.

您收到此错误，因为代码没有被照顾当这两个案例Username，以及Password失败，它是一个无限循环Do While Cells(1, 1).Value <> ""。因此i，数据类型设置为的 counter 的值Integer不断增加，一旦超过 32,767 的限制，就会产生Overflow错误。

In support of my above assertion, consider these arguments in your code:

为了支持我的上述断言，请在您的代码中考虑以下参数：

Condition 1 - Login Status is "fail":

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

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

Condition 2 - both Usernameand Passwordmatch:

条件2 -无论是Username与Password匹配：

ElseIf Username = u And Password = p Then

Condition 3 - Usernamedidn't match:

条件 3 -Username不匹配：

ElseIf Username <> u And Password = p Then

Condition 4 - Passworddidn't match:

条件 4 -Password不匹配：

ElseIf Username = u And Password <> p Then

Solution:

解决方案：

We need to change the infinite loop to finite, i.e. it will stop once it reaches to the blank cell - so it will be like Do While Cells(i, 1).Value <> "".

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

Also, we may add to the above, the condition when both Usernameand Passwordfail, which you have correctly identified, but I suspect, if it's still throwing error, it needs to be put at the right place, i.e. just after the Do Whileloop.

此外，我们可以在上面添加Username和Password失败时的条件，您已经正确识别，但我怀疑，如果它仍然抛出错误，则需要将其放在正确的位置，即在Do While循环之后。

Another small correction - ishould start with 2 instead of 1, as we want to lookup from the 2^ndrow.

另一个小的修正 -i应该从 2 而不是 1 开始，因为我们想从^第二行开始查找。

Therefore, let's put it all together:

因此，让我们把它们放在一起：

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

Keep in mind though, this is just a demonstrator. In practice, the message alert shouldn't so clearly spell out whether the mistake was on user id, or on password, or on both.

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

回答by YowE3K

I believe that the following may work better:

我相信以下可能效果更好：

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

Note: It is definitely a bad idea to hold passwords in clear text within a worksheet. It is too easy for people to obtain the entire list.

注意：在工作表中以明文形式保存密码绝对是一个坏主意。人们太容易获得整个列表。