VBA 宏：如何单击在 HTML 中更改类名的按钮？

Question

This is the website I am trying to reach. - > https://brokercheck.finra.org/ My vba code will allow me to get to the website, and input data in the cell box, but when I do, it doesn't really understand that there is text because the class changes when you input data manual, so when you do it with code, it doesn't change. Can anyone help please?

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

after this I get an error with the submit button because it doesn't activate the drop down list that it is embedded in the webpage. enter image description here

Answer 1

The page makes API calls to update content based on lat and lon of zipcode. You can find this in the network tab eg 1 , 2 . These API calls return a string containing json with the listings which can be parsed with a json parser after a little string manipulation|regex. This means, in this case, you can issue xhr requests (so no need for I/O of opening browser) and then parse the json. The total number of results is present in the responseText .

The json parser I use is Jsonconverter.bas: Download raw code from here and add to standard module called jsonConverter . You then need to go VBE > Tools > References > Add reference to Microsoft Scripting Runtime.

The following shows returning all results (all pages) for a given zipcode - both for By Firm and By Individual .

---

Firms:

Getting Firm results based on zip.

The API endpoint (construction):

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"

uses a query string where you can alter the number of results retrieved by the changing the nrows param. The limit is 100. The default is 12. If you wish to retrieve all results, you can make subsequent calls in batches of n eg 12 with the appropriate n cumulative offset adjustment to start param:

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

etc

In order to make less requests I would go with the max of n = 100 and alter the nrows param before a loop to collect all results, and the start (offset) param during the loop to get next batch.

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

---

Individuals:

At page = 91 there is limit exceeded. 90 requests actually yielded 9,000 results of total 11,960. It may be worth investigating whether that total is actually accurate as this may be the reason for no further results. For example, despite stating currently 11,960 results there are only 75 pages of 12 results per page ie only 750 of c.997 expected pages. 750 pages, at 12 results per page, gives 9,000 results which is the actual returned amount. The code below simply ceases looping if "limit exceeded" is found in the response.

I show extracting only specific items from json. There is a lot more info returned eg all current employments which can be more than 1. You can explore, for example, the json for the first request (first 100 listing) here .

If you are interested in a specific individual you can also use their CRD in an API call as shown at the very bottom section.

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

---

Single individual:

Detailed info for a single individual can be gained from:

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

Answer 2

By Whatever I understood of your problem. Maybe you can make use of Application.SendKeys . That's what I use when I need to input any information on Web.

Code: You can manipulate it as per your need.

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

Demo: