使用excel VBA从运行scrpits的网页中获取数据以显示表数据

Question

Day two of researching this. I'm just not getting it. The web page is public: https://register.fca.org.uk/ShPo_FirmDetailsPage?id=001b000000MfF1EAAV Manually I pgdn x 2 to get to the button [+] Individuals, click it then pgdn x 1 to get to the "results per page" drop down and change it to 500. then copy and paste the results into excel

this is the code that I found on this site "Selecting a dropdown list when inserting data from web (VBA)" answered by QHarr which I tried to adapt and failed miserably. I put "HELP" where I think I should be making the changes but I'm just guessing

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

So I have included your changes and am here.

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

You can use css attribute = value selectors to target the + for individuals and also to make the option selection for 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

This selector, [href*=FirmIndiv] , is an attribute = value selector with contains (*) modifier. It looks for the matches for href attributes that contain the substring FirmIndiv in the href value. querySelector all method of HTMLDocument *(ie.Document) will return the first match found.

You can see the match here:

The selector for the option tag element (the parent select tag for result counts contains child option tag elements):

#IndividualSearchResults_length [value='500']

It uses an id (#) selector to target the div parent, of the parent select element, by its id value IndividualSearchResults_length , then uses a descendant combinator (" ") followed by attribute = value selector to specify the option element with value = 500 .

You can see that here:

---

Selenium basic version:

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