Excel VBA 用户表单在服务器上使用用户名和密码登录

Question

我有一个用户表单，用户可以在其中输入用户名和密码。 我在这里找到了Excel VBA & UserForm Login and Password VLOOKUP Table in Sheet 中的代码

Private Sub LogIn_Click()
    Dim Username As String
    Dim Password As String
    Dim passWs As Worksheet
    Dim lRow As String
    Dim rng As Range
    Dim CorrectDetails As Boolean
    Dim i As Integer


    Username = Me.Username.Text

    Password = Me.Password.Text

    If Len(Trim(Username)) = 0 Then
        Me.Username.SetFocus
        MsgBox "Username", vbOKOnly, "Username"
        Exit Sub
    End If

    If Len(Trim(Password)) = 0 Then
        Me.Password.SetFocus
        MsgBox "Password", vbOKOnly, "Password"
        Exit Sub
    End If

    Set passWs = ThisWorkbook.Worksheets("Users")

    With passWs
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        For i = 1 To lRow
            If UCase(Trim(.Range("B" & i).Value)) = UCase(Trim(Username)) Then '<~~ Username Check
                If .Range("C" & i).Value = Password Then '<~~ Password Check
                    CorrectDetails = True
                    Unload Me
                    MsgBox "Välkommen " & Username


                    Sheets("Start").Activate

                    '~~> Admin is True
                    If .Range("D" & i).Value = "True" Then
                        '
                        '~~> Do what you want
                        '
                    Else
                        '
                        '~~> Do what you want
                        '
                    End If

                    Exit For
                End If
            End If
        Next i

        '~~> Incorrect Username/Password
        If CorrectDetails = False Then
            MsgBox "Felaktivt användarnamn och/eller lösenord"
        End If
    End With
End Sub

我还有一个在https://www.ozgrid.com/forum/forum/help-forums/excel-general/86714-vba-read-text-file-from-a-url 上找到的功能

Function GetFromWebpage(URL As String) As String
On Error GoTo Err_GetFromWebpage

Dim objWeb As Object
Dim strXML As String

' Instantiate an instance of the web object
Set objWeb = CreateObject("Microsoft.XMLHTTP")

' Pass the URL to the web object, and send the request
objWeb.Open "GET", URL, False
objWeb.send

' Look at the HTML string returned
strXML = objWeb.responsetext

GetFromWebpage = strXML


End_GetFromWebpage:
' Clean up after ourselves!
Set objWeb = Nothing
Exit Function

Err_GetFromWebpage:
' Just in case there's an error!
MsgBox Err.Description & " (" & Err.Number & ")"
Resume End_GetFromWebpage
End Function

该函数被调用：

Sub MainSub()
Dim MyString As String, s As String

MyString = GetFromWebpage("http://127.0.0.1/test3.csv")

s = MyString
Debug.Print s
End sub

我的 .csv 文件的内容是：

Username;Password
User1;123
User2;333

我试图将 mystring 拆分为用户名和密码对，然后检查我的登录表单是否输入的用户名和密码与服务器上的相同。

Answer 1

为了帮助您获取用户名和密码部分：

您可以使用 Excel 中的文本到列功能将其分成两列，然后循环播放。 但是，我会将 CSV 列 A info 读入一个数组，然后循环该数组。 使用带有分隔符";"的Split函数要生成您的对，将拆分中的值分配给密码和用户名变量，然后将它们用于您的测试。

下面需要调整的示例：

Option Explicit
Public Sub test()
    Dim ws As Worksheet, loginDetails(), currentLogin As Long, pairs() As String, lastRow As Long
    Set ws = Workbooks("name of CSV").Worksheets("Sheet1")   '<==change this to the open CSV name
    Dim pword As String, username As String
    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        If lastRow = 1 Then                      '<change to 2 if header present
            ReDim loginDetails(1, 1): loginDetails(1, 1) = .Range("A1").Value '<= change this to A2 if header
        Else
            loginDetails = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value 'Change to A2: if header present
        End If
        For currentLogin = LBound(loginDetails, 1) To UBound(loginDetails, 1)
            pword = vbNullString: username = vbNullString
            If InStr(loginDetails(currentLogin, 1), ";") > 0 Then
                pairs = Split(loginDetails(currentLogin, 1), ";")
                username = pairs(0)
                pword = pairs(1)
                'Debug.Print username, pword
                'other code to test login

            End If
        Next
    End With
End Sub