Vba 如何从没有表id的《华尔街日报》市场日记中获取数据；xmlresponse中有和或没有值

我正试图从中获取信息

这是我的密码

Private Function WebDownload() As Boolean
    Dim xml As XMLHTTP
    Dim sUrl As String
    Dim sValue As String
    Dim searchArray(7) As String
    Dim vRspText As Object
    Dim y, x, z As Integer
    Dim vString, vValue As Object
    Dim aRegArray As Object
    Dim s As String
    Dim tempStr As String
    Dim neg As Short
    Dim sMktSum As String
    Dim html As HTMLDocument, hTable As HTMLTable '<== Tools > References > Microsoft HTML Object Library
    Dim htmlobject As HTMLDivElement
    On Error GoTo Error_webDownload_Handler

    html = New HTMLDocument

    'false is default for boolean
    WebDownload = False

    xml = New XMLHTTP
    'sURL = "http://quote.yahoo.com/mo"
    sUrl = "https://www.wsj.com/market-data/stocks/marketsdiary"
    xml.open("GET", sUrl, False)
    'send the request and returns data
    xml.send()
    'set content to local variable
    'UPGRADE_WARNING: Couldn't resolve default property of object vRspText. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
    'vRspText = xml.responseText
    html.body.innerHTML = xml.responseText

    htmlobject = html.getElementById("root")
    MessageBox.Show(htmlobject)

    x = 1
    x = InStr(x, CStr(vRspText), "issuesTraded")
    If x > 0 Then
        If z = 0 Then
            'UPGRADE_WARNING: Couldn't resolve default property of object vRspText. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            sMktSum = Mid(vRspText, x, 20000)
            'UPGRADE_WARNING: Couldn't resolve default property of object RegExpTest(). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            sMktSum = RegExpTest("\d+(,?\ d \ d \ d) *\ .*\ d * ", sMktSum)
            sValue = Mid(sMktSum, 1, Len(sMktSum))
            _mvarDowClose = CDbl(sValue)
        End If
    End If

私有函数WebDownload（）为布尔值
将xml定义为XMLHTTP
作为字符串的Dim sUrl
作为字符串的Dim sValue
Dim searchArray（7）作为字符串
将文本设置为对象
将y、x、z调整为整数
Dim V字符串，V值作为对象
作为对象的Dim Aregaray
像线一样变暗
作为字符串的Dim tempStr
暗负电短
点心串
将html设置为HTMLDocument，将HTTable设置为HTMLTable'引用>Microsoft html对象库
将htmlobject设置为HtmlLevel
关于错误转到错误\u webDownload\u处理程序
html=新的HTMLDocument
'false是布尔值的默认值
WebDownload=False
xml=新的XMLHTTP
‘sURL=’http://quote.yahoo.com/mo"
苏尔=”https://www.wsj.com/market-data/stocks/marketsdiary"
open（“GET”、sUrl、False）
'发送请求并返回数据
xml.send（）
'将内容设置为局部变量
'升级\警告：无法解析对象vRspText的默认属性。点击查看更多信息：“ms”-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword=“6A50421D-15FE-4896-8A1B-2EC21E9037B2”
'vRspText=xml.responseText
html.body.innerHTML=xml.responseText
htmlobject=html.getElementById（“根”）
MessageBox.Show（htmlobject）
x=1
x=仪表（x，CStr（vRspText），“已发布”）
如果x>0，则
如果z=0，则
'升级\警告：无法解析对象vRspText的默认属性。点击查看更多信息：“ms”-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword=“6A50421D-15FE-4896-8A1B-2EC21E9037B2”
sMktSum=Mid（vRspText，x，20000）
'升级\警告：无法解析对象RegExpTest（）的默认属性。点击查看更多信息：“ms”-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword=“6A50421D-15FE-4896-8A1B-2EC21E9037B2”
sMktSum=RegExpTest（“\d+（，？\d\d\d）*\.*\d*”，sMktSum）
S值=中间（sMktSum，1，Len（sMktSum））
_mvarDowClose=CDbl（S值）
如果结束
如果结束

使用检查工具时，我能够看到表格单元格中的值，尽管在获取xml.responseText时，xml文件中没有数据值。我猜这是因为这些数据是从脚本中提取出来的

我试图通过查找带有

x=InStr（x，CStr（vRspText），“issuestrated”）

的单元格名称来刮取这些数据，尽管我无法在xml文件中找到数据值

---

我还尝试使用htmldocuments，尽管我无法使用htmlTable，因为我尝试获取的getElementById（）表没有ID值。因此，我研究了xpath。

通过对每个返回json的表的附加xhr请求动态检索数据。通过按F5刷新页面，您可以在“网络”选项卡中找到这些。然后可以从xhr列表中的表中搜索值

您需要一个json解析器来处理响应。在VBA中，JSON

{}

是一个字典，您可以循环

键的
或通过
键的
进行访问；[]表示您可以对每个
进行
收集。json是嵌套的。您需要熟悉这些概念。我将向您展示如何解析json并通过数组重新创建表，然后将其写入工作表。我会为第一张桌子做这个

对于我使用的json解析，从那里下载原始代码并添加到名为JsonConverter的标准模块中。然后需要转到
VBE>Tools>References>addreference
到
Microsoft脚本运行时
。从复制的代码中删除顶部属性行（这适用于导入.bas direct）

检查不同表的json结构，然后确定如何最好地重新编写代码，以便可以将代码部分作为函数/子函数重新用于每个xhr请求

Option Explicit

Public Sub GetMarketsDiary()
    Dim http As Object, ws As Worksheet, json As Object

    Set http = CreateObject("MSXML2.XMLHTTP")
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With http
        .Open "GET", "https://www.wsj.com/market-data/stocks/marketsdiary?id={""application"":""WSJ"",""marketsDiaryType"":""diaries""}&type=mdc_marketsdiary", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'mitigate for being served cached results
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        Set json = JsonConverter.ParseJson(.responseText)
    End With

    Dim instrumentSets As Object, singleSet As Object, header As Object
    Dim instrument As Object, r As Long, c As Long, key As Variant, results()

    Set instrumentSets = json("data")("instrumentSets") 'list of 4 needs converting to tables

    ReDim results(1 To instrumentSets.item(1)("instruments").Count * instrumentSets.Count + 1, 1 To instrumentSets.item(1)("headerFields").Count)

    For Each singleSet In instrumentSets
        c = 1: r = r + 1
        For Each header In singleSet("headerFields")
            results(r, c) = header("label")
            c = c + 1
        Next

        For Each instrument In singleSet("instruments")
            c = 1: r = r + 1
            For Each key In instrument
                If key <> "id" Then
                    results(r, c) = instrument(key)
                    c = c + 1
                End If
            Next
        Next
    Next

    With ws
        .Cells(1, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

选项显式
公共子市场数据表（）
Dim http作为对象，ws作为工作表，json作为对象
设置http=CreateObject（“MSXML2.XMLHTTP”）
设置ws=ThisWorkbook.Worksheets（“Sheet1”）
使用http
.打开“获取”https://www.wsj.com/market-data/stocks/marketsdiary?id={“应用程序”：“WSJ”，“marketsDiaryType”：“日记”}&type=mdc\u marketsdiary，False
.setRequestHeader“如果自”“Sat，2000年1月1日00:00:00 GMT”之后进行了修改，则会减轻对缓存结果的服务
.setRequestHeader“用户代理”、“Mozilla/5.0”
邮寄
设置json=JsonConverter.ParseJson（.responseText）
以
Dim InstrumentSet作为对象、singleSet作为对象、header作为对象
作为对象的Dim仪表，r为长，c为长，键为变量，结果（）
Set-instrumentSets=json（“数据”）（“仪器集”）需要转换为表的4个列表
ReDim结果（1到仪器集。第（1）项（“仪器”）。计数*仪器集。计数+1，1到仪器集。第（1）项（“人头场”）。计数）
对于仪表集中的每个单组
c=1:r=r+1
对于单个集合中的每个标头（“标头字段”）
结果（r，c）=标题（“标签”）
c=c+1
下一个
单套仪表中的每个仪表（“仪表”）
c=1:r=r+1
对于每个键入仪表
如果是“id”键，则
结果（r，c）=仪器（键）
c=c+1
如果结束
下一个
下一个
下一个
与ws
.单元格（1，1）.调整大小（UBound（结果，1），UBound（结果，2））=结果
以
端接头
要做到这一点，您需要自动使用浏览器-加载页面后，抓取所有
元素并检查（例如）每个元素的第一行，查找列标题：如果找到这些，您就知道这是您想要的表。