Как получить данные таблицы с веб-сайта, который использует метод POST с VB Excel? - PullRequest
1 голос
/ 10 октября 2019

Я хотел собрать данные (имя) из www.181.bh . Этот сайт использует метод POST и не позволяет изменять поиск с помощью URL.

Я использую Excel VB Macro для сбора данных с помощью следующего кода. Мне нужно собирать имена от 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 Ответ

0 голосов
/ 11 октября 2019

Существует способ отправить запрос POST с VBA, используя библиотеку Microsoft WinHTTP Services, version 5.1. Вы даже можете найти примеры, уже опубликованные как этот или этот .

Однако в вашей ситуации я бы предложил вместо этого перейти с 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

Обратите внимание, что вам может понадобиться обновить драйвер Chrome , расположенный в C:\ Users \ имя_пользователя \ AppData \ Local \ SeleniumBasic

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...