宏在解析来自 json 的内容时抛出一个奇怪的错误

Question

我正在尝试使用 xmlhttp 请求从 webpage 中抓取某些信息。我感兴趣的信息是 javascript 加密和动态加载的。但是，它们在页面源 (CTRL + U) 中可用。

当我使用正则表达式从页面源代码中挖出该部分并使用 JsonConverter 处理该部分时，我收到以下错误：

Run-time error `10001`:
Error parsing JSON:
"text":{"payload":{"

我试过：

Sub GrabRedfinInfo()
    Const siteLink$ = "https://www.redfin.com/TX/Austin/604-Amesbury-Ln-78752/unit-2/home/171045975"
    Dim HTML As HTMLDocument, Http As Object
    Dim jsonObject As Object, jsonStr As Object
    Dim itemStr As Variant, sResp As String

    Set HTML = New HTMLDocument
    Set Http = CreateObject("MSXML2.XMLHTTP")

    With Http
        .Open "Get", siteLink, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.190 Safari/537.36"
        .send
        HTML.body.innerHTML = .responseText
        sResp = .responseText
    End With

    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "reactServerState\.InitialContext = (.*);"
        .MultiLine = True
        Set jsonStr = .Execute(sResp)
    End With
    
    itemStr = jsonStr(0).submatches(0)
    
    Set jsonObject = JsonConverter.ParseJson(Replace(itemStr, "\", ""))
    MsgBox jsonObject("ReactServerAgent.cache")("dataCache")("/stingray/api/home/details/belowTheFold")("res")
End Sub

预期输出：

Active Under Contract
Active
Pending - Taking Backups
Active

下图显示了他们的行踪：

https://imgur.com/qcksyZ4

Answer 1

相反，我会更改正则表达式以使其更具限制性并仅针对管理字符串的事件。我会另外更改字符串替换以确保我正在交换 \" 与 ".

然后您将事件的时间轴作为 array/collection 结束。参见 here

示例：

代码：

Option Explicit

Public Sub GrabRedfinInfo()
    Const siteLink$ = "https://www.redfin.com/TX/Austin/604-Amesbury-Ln-78752/unit-2/home/171045975"
    Dim HTML As HTMLDocument, Http As Object
    Dim jsonObject As Object, jsonStr As Object
    Dim itemStr As Variant, sResp As String

    Set HTML = New HTMLDocument
    Set Http = CreateObject("MSXML2.XMLHTTP")

    With Http
        .Open "Get", siteLink, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.190 Safari/537.36"
        .send
        HTML.body.innerHTML = .responseText
        sResp = .responseText
    End With

    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = """events\"".(\[.*?\])"
        .MultiLine = True
        Set jsonStr = .Execute(sResp)
    End With
    
    itemStr = jsonStr(0).SubMatches(0)
    
    Set jsonObject = JsonConverter.ParseJson(Replace$(itemStr, "\" & Chr$(34), Chr$(34))) 'Array (collection)
    
    Dim evt As Object
    
    For Each evt In jsonObject
        Debug.Print evt("mlsDescription")
    Next

End Sub

宏在解析来自 json 的内容时抛出一个奇怪的错误

Macro throws a weird error while parsing content from json

vba

json

xmlhttprequest

web-scraping