从 xmlhttp.responseText 获取数据到 excel

Question

我正在编写一个宏来从网站获取一些数据。我在接下来的步骤中受到了打击。我想获取数据部分并在excel中打印。我在下面提供了用于打印数据的数据结构和代码。我正在尝试各种方法三天。运气不好！

"data": [{
 "annualisedVolatility": "37.35",
 "bestBuy": "6.04",.
  etc                               
 }]

VBA 代码：我把 URL 和数据放在一起；因此您可以在测试时删除变量

Sub getNSEFutData()
    ExpiryDate = Range("TSys_ExpiryDate")
    xRow = 4
    Do Until wksNSE50.Cells(xRow, 1) = ""
    scripID = wksNSE50.Cells(xRow, 1).Value
    scripID = Replace(scripID, "&", "%26")
    'URL = "http://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=" & scripID & "&instrument=FUTSTK&expiry=" & ExpiryDate
    URL = "http://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=ADANIPORTS&instrument=FUTSTK&expiry=25OCT2018"
    Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    xmlhttp.Open "GET", URL, False
    xmlhttp.setRequestHeader "Content-Type", "text/JSON"
    xmlhttp.Send
    sNo = InStr(1, xmlhttp.responseText, "id=" & Chr(34) & "responseDiv")
    Debug.Print xmlhttp.responseText
    Dim jsonStr As String
    jsonStr = Trim(Mid(xmlhttp.responseText, sNo, InStr(sNo, xmlhttp.responseText, "/div>") - sNo))
    Debug.Print jsonStr

    xRow = xRow + 1
    Loop

End Sub

Answer 1

这是使用JSONConvertor.bas 和整个 JSON 字符串（不仅仅是来自数据）。您只需调整当前确定 JSON 提取起点和终点的 InStr 方法。我正在从一个单元格中阅读。 “数据”是一个集合。第一项是包含您所追求的值的字典。您只需循环字典的键，如下所示。将这些写入一行很容易，例如，通过使用带有 rowCounter 和 columnCounter 变量的 Cells 添加单元格引用来定位。您将在外部循环中增加 rowCounter 以每次写入新行。

VBA：

Public Sub GetInfoFromSheet()
    Dim jsonStr As String, json As Object, key As Variant, columnCounter As Long, rowCounter As Long
    jsonStr = ThisWorkbook.Worksheets("Sheet1").[a1]
    Set json = JsonConverter.ParseJson(jsonStr)("data")(1)
    rowCounter = rowCounter + 1
    For Each key In json
        columnCounter = columnCounter + 1
        ThisWorkbook.Worksheets("Sheet2").cells(rowCounter, columnCounter) = key & " : " & json(key)
    Next
End Sub

---

JSON 树视图：

这是正在遍历的路径的视图：

---

JSON 字符串：

这是我正在使用的 JSON：

{
  "valid": "true",
  "tradedDate": "28SEP2018",
  "eqLink": "/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=ADANIPORTS",
  "data": [
    {
      "annualisedVolatility": "37.35",
      "bestBuy": "8.22",
      "totalSellQuantity": "6,65,000",
      "vwap": "338.01",
      "clientWisePositionLimits": "7807220",
      "optionType": "-",
      "highPrice": "342.35",
      "dailyVolatility": "1.95",
      "bestSell": "9.22",
      "marketLot": "2500",
      "sellQuantity5": "7,500",
      "marketWidePositionLimits": "156144401",
      "sellQuantity4": "2,500",
      "sellQuantity3": "2,500",
      "sellQuantity2": "2,500",
      "underlying": "ADANIPORTS",
      "sellQuantity1": "5,000",
      "pChange": "0.55",
      "premiumTurnover": "-",
      "totalBuyQuantity": "4,95,000",
      "turnoverinRsLakhs": "15,227.35",
      "changeinOpenInterest": "3,35,000",
      "strikePrice": "-",
      "openInterest": "98,67,500",
      "buyPrice2": "338.10",
      "buyPrice1": "338.25",
      "openPrice": "339.80",
      "prevClose": "336.55",
      "expiryDate": "25OCT2018",
      "lowPrice": "333.75",
      "buyPrice4": "338.00",
      "buyPrice3": "338.05",
      "buyPrice5": "337.95",
      "numberOfContractsTraded": "1,802",
      "instrumentType": "FUTSTK",
      "sellPrice1": "338.50",
      "sellPrice2": "338.55",
      "sellPrice3": "338.70",
      "sellPrice4": "338.75",
      "sellPrice5": "338.80",
      "change": "1.85",
      "pchangeinOpenInterest": "3.51",
      "ltp": "8.82",
      "impliedVolatility": "-",
      "underlyingValue": "336.20",
      "buyQuantity4": "7,500",
      "buyQuantity3": "2,500",
      "buyQuantity2": "5,000",
      "buyQuantity1": "2,500",
      "buyQuantity5": "5,000",
      "settlementPrice": "336.55",
      "closePrice": "0.00",
      "lastPrice": "338.40"
    }
  ],
  "companyName": "Adani Ports and Special Economic Zone Limited",
  "lastUpdateTime": "28-SEP-2018 11:41:23",
  "isinCode": null,
  "ocLink": "/marketinfo/sym_map/symbolMapping.jsp?symbol=ADANIPORTS&instrument=-&date=-&segmentLink=17&symbolCount=2"
}

---

注意：

如果您只想提取数据部分，而不是较长的字符串，请考虑调整您当前的 Instr 方法以检索以下有效的 JSON 字符串：

[{"annualisedVolatility":"37.35","bestBuy":"6.01","totalSellQuantity":"6,30,000","vwap":"337.78","clientWisePositionLimits":"7807220","optionType":"-","highPrice":"342.35","dailyVolatility":"1.95","bestSell":"7.80","marketLot":"2500","sellQuantity5":"2,500","marketWidePositionLimits":"156144401","sellQuantity4":"7,500","sellQuantity3":"2,500","sellQuantity2":"2,500","underlying":"ADANIPORTS","sellQuantity1":"2,500","pChange":"0.65","premiumTurnover":"-","totalBuyQuantity":"6,20,000","turnoverinRsLakhs":"24,370.83","changeinOpenInterest":"5,15,000","strikePrice":"-","openInterest":"1,00,47,500","buyPrice2":"338.30","buyPrice1":"338.35","openPrice":"339.80","prevClose":"336.55","expiryDate":"25OCT2018","lowPrice":"333.75","buyPrice4":"338.10","buyPrice3":"338.20","buyPrice5":"338.05","numberOfContractsTraded":"2,886","instrumentType":"FUTSTK","sellPrice1":"338.80","sellPrice2":"338.90","sellPrice3":"338.95","sellPrice4":"339.00","sellPrice5":"339.05","change":"2.20","pchangeinOpenInterest":"5.40","ltp":"7.60","impliedVolatility":"-","underlyingValue":"336.85","buyQuantity4":"7,500","buyQuantity3":"2,500","buyQuantity2":"5,000","buyQuantity1":"2,500","buyQuantity5":"5,000","settlementPrice":"336.55","closePrice":"0.00","lastPrice":"338.75"}]

Answer 2

我不清楚您是一开始就无法提取数据，还是仅提取您需要的部分。

在您提供的 URL 中，我没有看到任何与您的示例类似的数据。 （短语bestBuy 不存在，我看到像“337...”这样的数字，但没有看到“37...”。）

无论如何，如果您的问题是从提供给 Excel 的 URL 获取数据，最简单的方法是使用内置功能而不是重写现有功能。

---

'获取外部数据'

转到 Excel 中的 Data 选项卡，然后单击 From Web。出现提示时，输入 URL 并点击 Enter。结果会因您正在加载的页面而异，但在这种情况下，我单击左侧窗格中的Table 0，然后单击Load：

...然后 Excel 将数据整齐地加载到表格中，该表格可以在需要时自动更新/刷新，或者只需单击即可手动更新/刷新。

---

getHTTP

如果您出于某种原因需要使用 VBA 执行此操作，也可以这样做，但需要一些额外的工作。

为了从任何网站加载JSON 或HTML，我使用此功能：

Public Function getHTTP(ByVal sReq As String) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sReq, False
        .Send
        getHTTP = StrConv(.responseBody, vbUnicode)
    End With
End Function

---

示例用法：

由于我不确定您从哪里获取 JSON 数据，这里有一个示例，它使用 Stack Exchange API 显示 Stack Overflow 的 site status：

Sub GetSiteInfo()
    Const url = "https://api.stackexchange.com/2.2/info?site=stackoverflow"
    Dim json As String

    json = getHTTP(url) 'get JSON response

    If InStr(json, """error_id""") > 0 Or json = "" Then 'check for error
        MsgBox "There was a problem." & vbLf & vbLf & json, vbCritical
        Exit Sub
    End If

    json = Mid(json, InStr(json, "[{""") + 3) 'tidy response with string functions
    json = Left(json, InStr(json, "}],") - 1)
    json = Replace(Replace(Replace(json, Chr(34), ""), ",", vbNewLine), "_", " ")
    json = Replace(StrConv(Replace(json, ":", " :" & vbTab & vbTab _
            & vbTab), vbProperCase), " Per ", "/")

    MsgBox json, vbInformation, "Site Statistics" 'display response
End Sub

请注意如何使用基本的string functions 来管理像这样的简单响应的提取。

---

使用基本字符串函数提取值

作为另一个示例，使用问题顶部的 JSON 数据，如果字符串位于名为 json 的变量中，并且您想提取 bestBuy 的值，一种方法（几种可能的方法）将像这样：

Sub jsonExtract_Demo()
    Const json = "aaaaaaa""bestBuy"": ""6.04"",."           'for demo

    Dim pStart As Long, pStop As Long, bestBuy As Single
    Dim prefix As String, suffix As String
    prefix = "bestBuy"": """                                'equivalent to:   "bestBuy": "
    suffix = """"                                           'equivalent to a single   "

    pStart = InStr(json, prefix) + Len(prefix)              'find beginning of value
    pStop = InStr(pStart, json, suffix)                     'find end of value
    bestBuy = CSng(Mid(json, pStart, pStop - pStart))       'extract & convert value
    MsgBox "The value for 'bestBuy` is : " & bestBuy, vbInformation
End Sub

---

WEBSERVICE工作表函数

我想指出的最后一件事是一个经常被忽视的 Excel 工作表函数，它适用于大多数纯文本响应（例如 JSON example）：

在工作表单元格中输入：

=WEBSERVICE("https://raw.githubusercontent.com/bahamas10/css-color-names/master/css-color-names.json")

...您将立即看到原始文本结果，并准备好根据需要使用工作表函数进行操作。对于XML 响应，WEBSERVICE 可以与FILTERXML 结合使用XPath 提取特定数据，这对于基本的抓取需求非常方便。

以上链接中的更多信息。