VBA宏：将返回JSON数据以查询变量数据的VBA宏自动化

请参阅下面用于查询api调用的代码。如何更改代码以将变量数据列表拉入api调用？是否希望将名字、姓氏和zipcode的单独列表拉入api调用，并使用api调用循环将结果拉入电子表格？表1将包括如下数据，但有许多行：

Firstname      Lastname       Zipcode
John           Doe            55555

并将CRD返回到输入数据或多个CRD（如果有多个匹配）

输出数据将是带有CRD的输入数据，如下所示，每条记录不超过3条

Firstname      Lastname       Zipcode     CRD1      CRD2      CRD3
John           Doe            55555       xxxxxx    xxxxxx    xxxxxx

或者返回下面的当前结果字段也可以

CRD Number Indiv    Name    FINRA registered    Disclosures In industry since   Employer CRD    Employer Name   Employer City   Employer State  Employer Zip

对于55555中的JohnDoe，结果将返回api调用的第一个结果，如下所示

CRD Number Indiv  Name          FINRA registered  Disclosures  In industry since  
9999999           JOHN, X, DOE  1                 N            9/9/1999           
Employer CRD  Employer Name  Employer City  Employer State  Employer Zip
9999          Company Name   New York       NY              55555       

这是当前代码

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(), FNAME As String, LNAME As String, ZIPCODE As String
    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=12&query=FNAME+LNAME&r=25&sort=score+desc&wt=json"
    Dim xhr As Object, totalResults As Long, numPages As Long

    Set xhr = CreateObject("MSXML2.XMLHTTP")

    latLon = GetLatLon("ZIPCODE", 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", _
                    "Employer CRD", "Employer Name", "Employer City", "Employer State", "Employer Zip")
    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
On Error Resume Next
    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")
        results(r, 6) = row("_source")("ind_current_employments")(1)("firm_id")
        results(r, 7) = row("_source")("ind_current_employments")(1)("firm_name")
        results(r, 8) = row("_source")("ind_current_employments")(1)("branch_city")
        results(r, 9) = row("_source")("ind_current_employments")(1)("branch_state")
        results(r, 10) = row("_source")("ind_current_employments")(1)("branch_zip")
    Next
    On Error GoTo 0
    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

---

我希望它只是将CRD编号返回到表1中的输入变量数据，名称和zipcode列表，或者如果更简单的话，也可以从名称和zipcode上的第一个查询结果返回这些相同的字段。已尝试将其自动化，以输入表1中的变量数据，但仍会出现许多错误。

Hi@Qharr，这是导致问题的项目的下一阶段。为什么一个人会有多个crd，除非多个INDIV具有相同的名称？您可能还应该明确您当前的代码返回的内容以及您实际想要的内容如何不同，并解释您试图解决该问题的方法。编辑问题@Qharr和是的，可能有多个INDIV具有相同的名称，但即使只有第一个crd可以添加到名称和ZIPCODE的变量列表中，也可以工作，或者只将当前结果和字段返回到名称和ZIPCODE的变量列表中也可以工作。

CRD Number Indiv    Name    FINRA registered    Disclosures In industry since   Employer CRD    Employer Name   Employer City   Employer State  Employer Zip