页面调用 API 以根据邮政编码的 lat 和 lon 更新内容。您可以在网络选项卡中找到它，例如1，2。这些 API 调用返回一个包含 json 和列表的字符串，经过一些字符串操作|regex 后，可以使用 json 解析器对其进行解析。这意味着，在这种情况下，您可以发出 xhr 请求（因此无需打开浏览器的 I/O）然后解析 json。结果总数显示在responseText。
我使用的 json 解析器是 Jsonconverter.bas：从 here 下载原始代码并添加到名为 jsonConverter 的标准模块中。然后你需要去 VBE > Tools > References > Add reference to Microsoft Scripting Runtime。
以下显示返回给定邮政编码的所有结果（所有页面）-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 个请求实际上产生了 9,000 个结果，总计 11,960 个。可能值得调查该总数是否真的准确，因为这可能是没有进一步结果的原因。例如，尽管目前有 11,960 个结果，但每页只有 75 页 12 个结果，即只有 750 个 c.997 预期页面。 750 页，每页 12 个结果，提供 9,000 个结果，这是实际返回的数量。如果在响应中发现“超出限制”，下面的代码将停止循环。
我展示了仅从 json 中提取特定项目。返回了更多信息，例如当前所有可能超过 1 个的工作。例如，您可以探索第一个请求的 json（前 100 个列表）here。
如果您对特定个人感兴趣，您还可以在 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