如何从使用 VB Excel POST 方法的网站获取表格数据？

Posted 2023-04-19

【中文标题】如何从使用 VB Excel POST 方法的网站获取表格数据？

【英文标题】：How to get a table data from a website which use POST method with VB Excel?

【发布时间】：2019-10-10 19:08:25

【问题描述】：

我想从www.181.bh 收集数据（名称）。本网站使用 POST 方式，不允许通过 URL 改变搜索。

我正在使用 Excel VB 宏在以下代码的帮助下收集数据。我需要收集从 A 到 Z 的名称。对于提供的代码，我过去常常通过 URL 帮助获取它，但由于它使用 POST 方法，我的宏无法在其中抓取。

Sub Macro3()
'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+n
'
    Dim ie As Object, continueLoop As Boolean
    Dim uRL As String
    Dim doc As Object, hDiv As Object, hRef As Object
    Dim hA As Object
    Dim aChars(1 To 26) As String
    Dim x As Long, y As Long, z As Long
    Dim wb As Excel.Workbook, ws As Excel.Worksheet
    Set wb = Excel.ActiveWorkbook
    Set ws = wb.ActiveSheet
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    aChars(1) = "A"
    aChars(2) = "B"
    aChars(3) = "C"
    aChars(4) = "D"
    aChars(5) = "E"
    aChars(6) = "F"
    aChars(7) = "G"
    aChars(8) = "H"
    aChars(9) = "I"
    aChars(10) = "J"
    aChars(11) = "K"
    aChars(12) = "L"
    aChars(13) = "M"
    aChars(14) = "N"
    aChars(15) = "O"
    aChars(16) = "P"
    aChars(17) = "Q"
    aChars(18) = "R"
    aChars(19) = "S"
    aChars(20) = "T"
    aChars(21) = "U"
    aChars(22) = "V"
    aChars(23) = "W"
    aChars(24) = "X"
    aChars(25) = "Y"
    aChars(26) = "Z"
    y = 1   'Column A in Excel
    z = 1   'Row 1 in Excel
    x = 1   'Start array
    continueLoop = True
     ie.navigate "http://www.181.bh/Surname?alpha=A", , , , "Content-Type: application/x-www-form-urlencoded" & vbCrLf
    Do While ie.busy: DoEvents: Loop
    Do While ie.ReadyState <> 4: DoEvents: Loop
    Set doc = ie.document
        Do
            Set hDiv = doc.GetElementById("NamesIndex")
            Set hRef = hDiv.GetElementsByTagName("a")
            For Each hA In hRef
                y = 1 ' Resets back to column A
                ws.Cells(z, y).Value = hA.innertext
                DoEvents
                z = z + 1
            Next hA
            If x < 26 Then
                x = x + 1
                uRL = "http://www.181.bh/Surname?alpha=" + aChars(x)
                ie.navigate uRL, , , , "Content-Type: application/x-www-form-urlencoded" & vbCrLf
                Do While ie.busy: DoEvents: Loop
                Do While ie.ReadyState <> 4: DoEvents: Loop
                Set doc = ie.document
            Else
                continueLoop = False
            End If
        Loop Until continueLoop = False
    ActiveWorkbook.Save
End Sub

【参考方案1】：

有一种方法可以使用 Microsoft WinHTTP Services, version 5.1 库通过 VBA 发送 POST 请求。您甚至可以找到已经发布的示例，例如 this one 或 this one。

但是，在您的情况下，我建议改为使用 Selenium 并使用它来填充文本框，然后按按钮提交请求。

您可以通过以下方式使用 Selenium 的脚本执行方法来执行此操作：

Sub FillValueAndClick()

    Dim bot As New WebDriver
    bot.start "chrome", "http://www.181.bh/"
    bot.Get "/"

    Dim InputBoxValue As String
    InputBoxValue = "Test"

    Dim javascriptCode As String
    JavaScriptCode = "document.getElementById('ContentPlaceHolder1_txtName').value='" & InputBoxValue & "'"
    bot.ExecuteScript JavaScriptCode 

    bot.FindElementByName("ctl00$ContentPlaceHolder1$btnSubmit1").Click


End Sub

请注意，您可能需要 update the Chrome driver 位于 C:\Users\YourUserName\AppData\Local\SeleniumBasic

【讨论】：

谢谢，我使用了 Selenium，它非常有用。然而，我现在面临的问题是如何在 Selenium 的帮助下在这个网站上用不同的字符（A 到 Z）填充搜索框？你知道一个特殊的功能吗？

@Loder 我在答案中添加了一个代码示例。让我知道这是否有效。