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