VBA 宏：如何單擊在 HTML 中更改類名的按鈕？

Question

這是我試圖訪問的網站。 - > https://brokercheck.finra.org/我的 vba 代碼將允許我訪問該網站，並在單元格框中輸入數據，但是當我這樣做時，它並沒有真正理解有文本，因為類當您手動輸入數據時會發生變化，因此當您使用代碼進行輸入時，它不會改變。 有人可以幫忙嗎？

Set elements = html.getElementsByClassName("md-tab ng-scope ng-isolate-scope md-ink-ripple")

Set elements2 = html.getElementsByClassName("md-raised md-primary md-hue-2 md-button md-ink-ripple") 

Set elements3 = html.getElementsByClassName("ng-scope selected")

Dim count As Long
Dim erow As Long count = 0

'This changes the form selection
For Each element In elements If element.className = "md-tab ng-scope ng-isolate-scope md-ink-ripple" Then element.Click 
Next element

'this inputs the data on the city cell in HTML html.getElementById("acFirmLocationId").Value = "30047"

'this pushes the submit button 
For Each element2 In elements2 
If element2.className = "md-raised md-primary md-hue-2 md-button md-ink-ripple" Then element2.Click 
Next element2

在此之后，我收到提交按鈕的錯誤，因為它沒有激活它嵌入在網頁中的下拉列表。 在此處輸入圖片說明

Answer 1

該頁面根據郵政編碼的經緯度進行 API 調用以更新內容。 您可以在網絡選項卡中找到它，例如1 、 2 。 這些 API 調用返回一個包含 json 的字符串，其中的列表可以在稍加字符串操作后使用 json 解析器進行解析|正則表達式。 這意味着，在這種情況下，您可以發出xhr請求（因此無需打開瀏覽器的 I/O），然后解析 json。 結果總數出現在responseText 。

我使用的 json 解析器是 Jsonconverter.bas：從這里下載原始代碼並添加到名為jsonConverter標准模塊。 然后，您需要轉到 VBE > 工具 > 引用 > 添加對 Microsoft 腳本運行時的引用。

下面顯示了返回給定郵政編碼的所有結果（所有頁面） - 包括By Firm和By Individual 。

---

公司：

根據 zip 獲得Firm結果。

API 端點（構造）：

apiUrl = "https://api.brokercheck.finra.org/firm?hl=true&json.wrf=angular.callbacks._6&lat={LAT}&lon={LON}&nrows=100&r=25&sort=score+desc&{START}&wt=json"

使用查詢字符串，您可以在其中更改通過更改nrows參數檢索的結果數。 限制為 100。默認為 12。如果您希望檢索所有結果，您可以以n為批進行后續調用，例如 12，並使用適當的n累積偏移調整來start參數：

GET /firm?hl=true&json.wrf=angular.callbacks._7&lat=33.864146&lon=-84.114088&nrows=100&r=25&sort=score+desc&start=0&wt=json
GET /firm?hl=true&json.wrf=angular.callbacks._7&lat=33.864146&lon=-84.114088&nrows=100&r=25&sort=score+desc&start=100&wt=json

等等

為了減少請求，我會使用 n = 100 的最大值並在循環之前更改nrows參數以收集所有結果，並在循環期間更改start （偏移）參數以獲得下一批。

Option Explicit
'Firm
Public r As Long

Public Sub GetListings()
    '<  VBE > Tools > References > Microsoft Scripting Runtime
    Dim json As Object, apiUrl As String, re As Object, s As String, latLon()
    r = 0
    Set re = CreateObject("VBScript.RegExp")
    apiUrl = "https://api.brokercheck.finra.org/firm?hl=true&json.wrf=angular.callbacks._6&lat={LAT}&lon={LON}&nrows=100&r=25&sort=score+desc&{START}&wt=json"

    Dim xhr As Object, totalResults As Long, numPages As Long

    Set xhr = CreateObject("MSXML2.XMLHTTP")

    latLon = GetLatLon("30047", xhr, re) '"30047" is the zipcode of interest and could be passed as a constant set at top of module or as a local variable changed set in a loop. over zipcodes
    apiUrl = Replace$(Replace$(apiUrl, "{LAT}", latLon(0)), "{LON}", latLon(1))
    s = GetApiResults(xhr, Replace$(apiUrl, "{START}", "start=0"), re)

    If s = "No match" Then Exit Sub

    Set json = JsonConverter.ParseJson(s)("hits")

    totalResults = json("total")

    numPages = Application.RoundUp(totalResults / 100, 0)

    Dim results(), ws As Worksheet, headers(), i As Long
    ReDim results(1 To totalResults, 1 To 3)

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    headers = Array("CRD Number", "Name", "Address")
    results = GetFirmListings(results, json("hits"))

    If numPages > 1 Then
        For i = 2 To numPages
            s = GetApiResults(xhr, Replace$(apiUrl, "{START}", "start=" & (i - 1) * 100), re)
            If s = "No match" Or InStr(s, "Exceeded limit") > 0 Then Exit For
            Set json = JsonConverter.ParseJson(s)("hits")
            results = GetFirmListings(results, json("hits"))
        Next
    End If
    With ws
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

Public Function GetLatLon(ByVal zip As String, ByVal xhr As Object, ByVal re As Object) As Variant
    Dim json As Object, lat As String, lon As String
    With xhr
        .Open "GET", Replace$("https://api.brokercheck.finra.org/locations?query={ZIP}&results=1", "{ZIP}", zip), False
        .send
        Set json = JsonConverter.ParseJson(.responseText)("hits")("hits")(1)("_source")
        lat = json("latitude")
        lon = json("longitude")
        GetLatLon = Array(lat, lon)
    End With
End Function

Public Function GetApiResults(ByVal xhr As Object, ByVal apiUrl As String, ByVal re As Object) As String
    With xhr
        .Open "GET", apiUrl, False
        .send
        GetApiResults = GetJsonString(re, .responseText)
    End With
End Function

Public Function GetFirmListings(ByVal results As Variant, ByVal json As Object) As Variant
    Dim row As Object, address As Object
    Dim addressToParse As String, addressToParse2 As String
    'Crd number, name and office address

    For Each row In json
        r = r + 1
        results(r, 1) = row("_source")("firm_source_id")
        results(r, 2) = row("_source")("firm_name")
        addressToParse = Replace$(row("_source")("firm_ia_address_details"), "\""", Chr$(32))
        addressToParse2 = Replace$(row("_source")("firm_address_details"), "\""", Chr$(32))
        addressToParse = IIf(addressToParse = vbNullString, addressToParse2, addressToParse)
        If addressToParse <> vbNullString Then
            Set address = JsonConverter.ParseJson(addressToParse)("officeAddress")
            results(r, 3) = Join$(address.items, " ,")
        End If
    Next
    GetFirmListings = results
End Function

Public Function GetJsonString(ByVal re As Object, ByVal responseText As String) As String
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\((.*)\);" 'regex pattern to get json string
        If .Test(responseText) Then
            GetJsonString = .Execute(responseText)(0).SubMatches(0)
        Else
            GetJsonString = "No match"
        End If
    End With
End Function

---

個人：

在頁面 = 91 處超出限制。 90 個請求實際上產生了 11,960 個結果中的 9,000 個結果。 可能值得調查該總數是否真的准確，因為這可能是沒有進一步結果的原因。 例如，盡管目前聲明了 11,960 個結果，但每頁只有 75 頁，每頁 12 個結果，即只有 750 頁的 c.997 預期頁面。 750 頁，每頁 12 個結果，給出 9,000 個結果，這是實際返回的數量。 如果在響應中發現“超出限制”，下面的代碼只是停止循環。

我展示了僅從 json 中提取特定項目。 返回了更多信息，例如所有當前的就業機會可能超過 1。例如，您可以在此處瀏覽第一個請求（前 100 個列表）的 json。

如果您對特定個人感興趣，您還可以在 API 調用中使用他們的 CRD，如最底部所示。

Option Explicit
'Individual
Public r As Long

Public Sub GetListings2()
    '<  VBE > Tools > References > Microsoft Scripting Runtime
    Dim json As Object, apiUrl As String, re As Object, s As String, latLon()
    r = 0
    Set re = CreateObject("VBScript.RegExp")
    apiUrl = "https://api.brokercheck.finra.org/individual?hl=true&includePrevious=false&json.wrf=angular.callbacks._d&lat={LAT}&lon={LON}&nrows=100&r=25&sort=score+desc&{START}&wt=json"
    Dim xhr As Object, totalResults As Long, numPages As Long

    Set xhr = CreateObject("MSXML2.XMLHTTP")

    latLon = GetLatLon("30047", xhr, re)
    apiUrl = Replace$(Replace$(apiUrl, "{LAT}", latLon(0)), "{LON}", latLon(1))
    s = GetApiResults(xhr, Replace$(apiUrl, "{START}", "start=0"), re)

    If s = "No match" Then Exit Sub

    Set json = JsonConverter.ParseJson(s)("hits")

    totalResults = json("total")

    numPages = Application.RoundUp(totalResults / 100, 0)

    Dim results(), ws As Worksheet, headers(), i As Long

    'example info retrieved. There is a lot more info in json
    headers = Array("CRD Number Indiv", "Name", "FINRA registered", "Disclosures", "In industry since")
    ReDim results(1 To totalResults, 1 To UBound(headers) + 1)

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    results = GetIndividualListings(results, json("hits"))
    If numPages > 1 Then
        For i = 2 To numPages
            DoEvents
            s = GetApiResults(xhr, Replace$(apiUrl, "{START}", "start=" & (i - 1) * 100), re)
            If s = "No match" Or InStr(s, "Exceeded limit") > 0 Then Exit For
            Set json = JsonConverter.ParseJson(s)("hits")
            results = GetIndividualListings(results, json("hits"))
        Next
    End If
    With ws
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

Public Function GetLatLon(ByVal zip As String, ByVal xhr As Object, ByVal re As Object) As Variant
    Dim json As Object, lat As String, lon As String
    With xhr
        .Open "GET", Replace$("https://api.brokercheck.finra.org/locations?query={ZIP}&results=1", "{ZIP}", zip), False 'changed results = 10 to results = 1
        .send
        Set json = JsonConverter.ParseJson(.responseText)("hits")("hits")(1)("_source")
        lat = json("latitude")
        lon = json("longitude")
        GetLatLon = Array(lat, lon)
    End With
End Function

Public Function GetApiResults(ByVal xhr As Object, ByVal apiUrl As String, ByVal re As Object) As String
    With xhr
        .Open "GET", apiUrl, False
        .send
        GetApiResults = GetJsonString(re, .responseText)
    End With
End Function

Public Function GetIndividualListings(ByVal results As Variant, ByVal json As Object) As Variant
    Dim row As Object
      'can have numerous current employments. Alter here and below if want more info from json about the individual

    For Each row In json
        r = r + 1
        results(r, 1) = row("_source")("ind_source_id")
        results(r, 2) = Replace$(Join$(Array(row("_source")("ind_firstname"), row("_source")("ind_middlename"), row("_source")("ind_lastname")), ", "), ", , ", ", ")
        results(r, 3) = row("_source")("ind_approved_finra_registration_count")
        results(r, 4) = row("_source")("ind_bc_disclosure_fl")
        results(r, 5) = row("_source")("ind_industry_cal_date")
    Next
    GetIndividualListings = results
End Function

Public Function GetJsonString(ByVal re As Object, ByVal responseText As String) As String
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\((.*)\);" 'regex pattern to get json string
        If .Test(responseText) Then
            GetJsonString = .Execute(responseText)(0).SubMatches(0)
        Else
            GetJsonString = "No match"
        End If
    End With
End Function

---

單身人士：

可以從以下位置獲得單個人的詳細信息：

https://api.brokercheck.finra.org/individual/1614374?json.wrf=angular.callbacks._h&wt=json

Answer 2

不管我對你的問題的理解。 也許您可以使用Application.SendKeys 。 這就是我需要在 Web 上輸入任何信息時使用的方法。

代碼：您可以根據需要對其進行操作。

Sub gottt()

Dim ie As Object
Dim el As Object


Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "https://brokercheck.finra.org/"
ie.Visible = True

    Do While ie.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

For Each el In ie.document.getElementsByTagName("span")
    If el.innerText = "Firm" Then el.Click
Next

Application.Wait DateAdd("s", 1, Now)

For Each el In ie.document.getElementsByTagName("input")


   If el.getAttribute("name") = "acFirmLocation" Then
        el.Focus
        Application.SendKeys ("30047"), True
        Application.Wait DateAdd("s", 1, Now)
    End If

Next


Application.Wait DateAdd("s", 1, Now)

For Each el In ie.document.getElementsByClassName("md-raised md-primary md-hue-2 md-button md-ink-ripple")
   If el.getAttribute("aria-label") = "FirmSearch" Then el.Click
Next



End Sub

演示：