использование Excel VBA для получения данных с веб-страницы, на которой выполняются скрипты для отображения данных таблицы

Question

Второй день исследования этого.Я просто не понимаюВеб-страница общедоступна: https://register.fca.org.uk/ShPo_FirmDetailsPage?id=001b000000MfF1EAAV Вручную я pgdn x 2, чтобы перейти к кнопке [+] Отдельные лица, щелкните по ней, затем pgdn x 1, чтобы перейти к раскрывающемуся списку «Результаты на странице», и измените его на 500.затем скопируйте и вставьте результаты в excel

. Это код, который я нашел на этом сайте «Выбор выпадающего списка при вставке данных из Интернета (VBA)», на который ответил QHarr, который я попытался адаптировать и потерпел неудачу.Я поставил «HELP» там, где я думаю, что я должен внести изменения, но я просто предполагаю

Public Sub MakeSelectiongGetData()
Dim IE As New InternetExplorer
Const URL = "https://register.fca.org.uk/ShPo_FirmDetailsPage?id=001b000000Mfe5TAAR#ShPo_FirmDetailsPage"
'Const optionText As String = "RDVT11"
Application.ScreenUpdating = False
With IE
    .Visible = True
    .navigate URL

    While .Busy Or .readyState < 4: DoEvents: Wend

    Dim a As Object
    Set a = .document.getElementById("HELP")

    Dim currentOption As Object
    For Each currentOption In a.getElementsByTagName("HELP")
        If InStr(currentOption.innerText, optionText) > 0 Then
            currentOption.Selected = "HELP"
            Exit For
        End If
    Next currentOption
    .document.getElementById("HELP").Click
    While .Busy Or .readyState < 4: DoEvents: Wend

    Dim nTable As HTMLTable

    Do: On Error Resume Next: Set nTable = .document.getElementById("HELP"): On Error GoTo 0: DoEvents: Loop While nTable Is Nothing

    Dim nRow As Object, nCell As Object, r As Long, c As Long

    With ActiveSheet
        Dim nBody As Object
        Set nBody = nTable.getElementsByTagName("tbody")(0).getElementsByTagName("tr")
        .Cells(1, 1) = nBody(0).innerText
        For r = 2 To nBody.Length - 1
            Set nRow = nBody(r)
            For Each nCell In nRow.Cells
                c = c + 1: .Cells(r + 1, c) = nCell.innerText
            Next nCell
            c = 0
      Next r
End With
.Quit
End With
Application.ScreenUpdating = True
End Sub

Итак, я включил ваши изменения и нахожусь здесь.

Public Sub MakeSelections()
Dim IE As New InternetExplorer
With IE
    .Visible = True
    .Navigate2 "https://register.fca.org.uk/ShPo_FirmDetailsPage?id=001b000000MfF1EAAV"

    While .Busy Or .readyState < 4: DoEvents: Wend

    .document.querySelector("[href*=FirmIndiv]").Click '<==click the + for indiv
    .document.querySelector("#IndividualSearchResults_length[value='500']").Selected = True
End With

Dim nTable As HTMLTable

Do: On Error Resume Next: Set nTable =IE.document.getElementById("IndividualSearchResults"): On Error GoTo 0: DoEvents: Loop While nTable Is Nothing

Dim nRow As Object, nCell As Object, r As Long, c As Long

With ActiveSheet
    Dim nBody As Object
    Set nBody = nTable.getElementsByTagName("Name")(0) _
                      .getElementsByTagName("ShG1_IRN_c") _
                      .getElementsByTagName("ShGl_IndividualStatus__c") _
                      .getElementsByTagName("ShPo_Registerstatus__c") _
                      .getElementsByTagName("Id") _
                      .getElementsByTagName("RecordTypeId") _
                      .getElementsByTagName("CurrencyIsoCode") _
    .Cells(1, 1) = nBody(0).innerText
    For r = 2 To nBody.Length - 1
        Set nRow = nBody(r)
        For Each nCell In nRow.Cells
            c = c + 1: .Cells(r + 1, c) = nCell.innerText
        Next nCell
        c = 0
    Next r
End With

End Sub

Answer 1

Вы можете использовать селекторы css attribute = value , чтобы настроить + для отдельных лиц, а также сделать выбор варианта для 500

 Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub MakeSelections()
    Dim IE As New InternetExplorer
    With IE
        .Visible = True
        .Navigate2 "https://register.fca.org.uk/ShPo_FirmDetailsPage?id=001b000000MfF1EAAV"

        While .Busy Or .readyState < 4: DoEvents: Wend

        .document.querySelector("[href*=FirmIndiv]").Click '<==click the + for indiv
        .document.querySelector("#IndividualSearchResults_length [value='500']").Selected = True

        Dim event_onchange As Object
        Set event_onchange = .document.createEvent("HTMLEvents")
        event_onchange.initEvent "change", True, False

        .document.querySelector("[name=IndividualSearchResults_length]").dispatchEvent event_onchange

        Application.Wait Now + TimeSerial(0, 0, 5)
        Dim clipboard As Object, ws As Worksheet

        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        Set ws = ThisWorkbook.Worksheets("Sheet1")
        clipboard.SetText .document.querySelector("#IndividualSearchResults").outerHTML
        clipboard.PutInClipboard
        ws.Cells(1, 1).PasteSpecial
        .Quit
    End With
End Sub

Этот селектор, [href*=FirmIndiv], являетсяАтрибут атрибут = значение с модификатором contains (*).Он ищет совпадения для атрибутов href, которые содержат подстроку FirmIndiv в значении href.querySelector all метод HTMLDocument * (т.е.. Документ) вернет первое найденное совпадение.

Вы можете увидеть совпадение здесь:

Селектордля элемента тега option (родительский тег select для подсчета результатов содержит дочерние элементы тега option):

#IndividualSearchResults_length [value='500']

Используется селектор id (#) длянацелить на родителя div родительского элемента select по значению его идентификатора IndividualSearchResults_length, затем использовать комбинатор потомков (""), а затем селектор attribute = value, чтобы указать элемент option сvalue = 500.

Вы можете увидеть это здесь:

---

Базовая версия Selenium:

Option Explicit 
Public Sub MakeChanges()
'VBE > Tools > References > Selenium Type Library
'Download: https://github.com/florentbr/SeleniumBasic/releases/tag/v2.0.9.0
    Dim d As WebDriver
    Set d = New ChromeDriver
    Const url = "https://register.fca.org.uk/ShPo_FirmDetailsPage?id=001b000000MfF1EAAV"

    With d
        .Start "Chrome"
        .get url
        .FindElementByCss("[href*=FirmIndiv]").Click
         .FindElementByCss("[name=IndividualSearchResults_length]").WaitDisplayed True, 10000
         .FindElementByCss("[name=IndividualSearchResults_length]").AsSelect.SelectByValue "500"
        Stop                                     '<==delete me later
        .Quit
    End With
End Sub