Excel VBA用户名/密码查找

Question

Private Sub cmdLogin_Click()
On Error GoTo ErrorHandler

Dim RowNo As Long
Dim Id As String
Dim pw As String
Dim ws As Worksheets

Application.ScreenUpdating = False
Set ws = Worksheets("User&Pass")
Id = LCase(Me.txtLogin)


RowNo = Application.WorksheetFunction.Match(Id, ws.range("A2:A999"), 0)

CleanExit:
Set ws = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
Exit Sub

ErrorHandler:
MsgBox "Unable to match ID, enter valid ID.", vbOKOnly 
GoTo CleanExit

End Sub

我正在制作一个Excel用户表单，现在我需要添加一个登录界面来使其看起来更加专业。我已经开始使用上述代码，但是我遇到了一个死胡同。

我的目标是说，如果id和密码匹配，则加载工作簿或取消隐藏工作簿并继续。用户名和密码存储在名为"User&Pass"的工作表上。目标是从该工作表的A列读取用户名，B列读取密码，如果成功，我会隐藏该工作表，以便用户无法查看其他用户的信息。

使用我上面的代码，我只需要让它判断是否与用户列匹配，然后继续匹配相应密码列的内容，否则转到错误处理程序。

我可以进行格式设置，如隐藏和取消隐藏工作表等，只需要帮助读取用户名和密码。

非常感谢您的帮助！

Z

第一次修改尝试：

Private Sub cmdLogin_Click()
On Error GoTo ErrorHandler
Dim RowNo As Long
Dim Id As String
Dim pw As String
Dim ws As Worksheets
Application.ScreenUpdating = False
Set ws = Worksheets("User&Pass")

Id = LCase(Me.txtLogin)
RowNo = Application.WorksheetFunction.Match(Id, ws.range("A2:A999"), 0)
RowNo = RowNo + 1
pw = ws.range("B" & RowNo)
If pw = Me.txtLogin Then
'continue
txt1.Value = "yes"
Else
GoTo ErrorHandler
End If


CleanExit:
Set ws = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
Exit Sub
ErrorHandler:
MsgBox "Unable to match ID, enter valid ID.", vbOKOnly
GoTo CleanExit
End Sub

@siddarthRout

Private Sub cmdLogin_Click()
Dim RowNo As Long
Dim Id As String, pw As String
Dim ws As Worksheet
Dim aCell As range
On Error GoTo ErrorHandler
Application.ScreenUpdating = True

Set ws = Worksheets("Details")
Id = LCase(Me.txtLogin)

Set aCell = ws.Columns(1).Find(What:=Id, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

'~~> If match found
If Not aCell Is Nothing Then
RowNo = aCell.Row
'~~> Rest of your code. For example if the password is
'~~> Stored in Col B then
Debug.Print aCell.Offset(, 1)
Unload Me
FrmMenu.Show
'~~> You can then use the above aCell.Offset(, 1) to
'~~> match the password which the user entered
Else '<~~ If not found
MsgBox "Unable to match ID, enter valid ID.", vbOKOnly
End If
CleanExit:
Set ws = Nothing
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox Err.Description
Resume CleanExit
End Sub

- Zenaphor

---

为什么不只是有一个授权用户列表，然后验证已登录的Windows用户名是否在其中？这样就不需要用户名和密码表单了。 - SWa

我曾经考虑过这个问题，但是现有的限制不允许我这样做。我只需要让它看起来更专业一些，这样当你打开Excel应用程序时，它会提示表格，如果匹配工作表，则继续，否则将其退出。我不担心安全等问题，只是人们更喜欢在我工作的地方看到这种外观。 - Zenaphor

@Kyle有一个不错的方法，但在某些情况下我被阻止了。此外，硬编码登录和/或密码会更加麻烦一些，但它使得入侵变得稍微困难一些。对于熟悉VBE的人来说，几乎总是可以突破这种方式，并且有黑客类型的人可以编写代码使其更容易。然而，如果你真的只是想要进行用户管理，就像你所说的那样，那么你的方法是可以的！ - Gaffi

@SiddharthRout 从未听说过这条路线。 :-) 能否提供教程链接？ - Gaffi

@Gaffi：当然没问题 :) 这是一个例子 http://www.vbforums.com/showpost.php?p=3445523&postcount=6 在这个例子中，我正在将数据写入文本文件，并且使用的是vb6，但是同样的概念也适用于VBA。只需将数据写入Excel单元格即可。 - Siddharth Rout

Answer 1

已测试和实践

您想要尝试的是这个吗？

代码

Option Explicit

Private Sub cmdLogin_Click()
    Dim RowNo As Long
    Dim Id As String, pw As String
    Dim ws As Worksheet
    Dim aCell As Range

    On Error GoTo ErrorHandler

    If Len(Trim(txtLogin)) = 0 Then
        txtLogin.SetFocus
        MsgBox "Username cannot be empty"
        Exit Sub
    End If

    If Len(Trim(txtPassword)) = 0 Then
        txtPassword.SetFocus
        MsgBox "Password cannot be empty"
        Exit Sub
    End If

    Application.ScreenUpdating = False

    Set ws = Worksheets("User&Pass")
    Id = LCase(Me.txtLogin)

    Set aCell = ws.Columns(1).Find(What:=Id, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    '~~> If match found
    If Not aCell Is Nothing Then
        RowNo = aCell.Row
        If Me.txtPassword = aCell.Offset(, 1) Then
            FrmMenu.Show
            Unload Me
        Else
            MsgBox "Unable to match UserID or PasswordID, Please try again", vbOKOnly
        End If
    Else '<~~ If not found
        MsgBox "Unable to match UserID or PasswordID, Please try again", vbOKOnly
    End If
CleanExit:
    Set ws = Nothing
    Application.ScreenUpdating = True
    Exit Sub
ErrorHandler:
    MsgBox Err.Description
    Resume CleanExit
End Sub

提示:

从安全角度考虑，永远不要让用户知道具体错误是用户名还是密码。始终显示通用消息，如"无法匹配UserID或PasswordID，请重试" :)

希望对你有所帮助。

Sid

- Siddharth Rout

---

类似于上面，它提示我进入错误处理程序而不是让我卸载进度，为了测试它的进度，我告诉它写入文本框“是”的值，但它只是将我发送到错误处理程序。 - Zenaphor

@Zenaphor：请在您的第一篇帖子中更新您正在使用的确切代码 :) - Siddharth Rout

我使用了您上面提供的内容，并将其保留为单元格偏移量，因为它是紧挨在旁边的。 - Zenaphor

@Zenaphor：那么你在哪里卸载表单？如果你已经包含了“Exit Sub”，那么除非有实际错误，否则它不会在错误处理程序中显示消息。在上面的代码中，根据情况，您将看到三种不同类型的消息。1）如果找到匹配项，则在立即窗口中；2）如果未找到匹配项，则为消息框“无法匹配ID，请输入有效的ID。”；3）如果出现错误，则为错误消息。例如，“User＆Pass”没有工作表或没有名为txtLogin的文本框。 - Siddharth Rout

只有在现在两个输入框都有输入时，程序才会继续执行。但是，如果我只输入了用户名和错误的密码，就不会再提示错误或重新尝试了。 - Zenaphor

Answer 2

另一种方式

On Error Resume Next
If Me.password <> Application.VLookup(Me.username, Sheet1.Cells(1, 1).CurrentRegion, 2, False) Then
    MsgBox ("incorrect")
    Exit Sub
Else
    MsgBox ("Correct Password Entered")
End If

此外，您需要确保从一开始就将所有工作表设置为xlSheetVeryHidden，以防止宏被禁用，并在成功的登录例程中取消隐藏。您还需要在VBA项目上设置密码，以防止其他人取消隐藏工作表。但请记住，Excel的安全性与湿纸袋差不多 ;)

- SWa

---

是的，我认为以上所有内容，人们不会尝试入侵它，因为它是公司工具，或者将成为公司工具，只是让管理人员认为有比实际更多的控制。 - Zenaphor