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

Question

研究这个的第二天。我只是不明白。网页是公开的： https://register.fca.org.uk/ShPo_FirmDetailsPage?id=001b000000MfF1EAAV 手动我 pgdn x 2 到按钮 [+] 个人，单击它然后 pgdn x 1 到“每页结果”下拉菜单并将其更改为 500。然后将结果复制并粘贴到 excel 中

这是我在此站点上找到的代码“从 Web (VBA) 插入数据时选择下拉列表”，由 QHarr 回答，我试图适应并惨遭失败。我把“帮助”放在我认为应该进行更改的地方，但我只是在猜测

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] 是一个带有包含 (*) 修饰符的属性 = 值选择器。它在 href 值中查找包含子字符串 FirmIndiv 的 href 属性的匹配项。 HTMLDocument *(ie.Document) 的 querySelector all 方法将返回找到的第一个匹配项。

你可以在这里看到比赛：

option 标签元素的选择器（结果计数的父 select 标签包含子 option 标签元素）：

#IndividualSearchResults_length [value='500']

它使用id (#) selector 来定位div 父级，父级select 元素的id 值IndividualSearchResults_length，然后使用descendant combinator (" ") 后跟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