对象不支持此属性或方法错误-VBA

Question

我有一个Excel宏，它从内部网站提取数据，但突然它停止工作并吐出“对象不支持此属性或方法”。错误。

调试标记为“设置JSON”行。

您知道如何解决此错误吗？

谢谢。

Option Explicit

Sub Test2()
Dim buildingId$: buildingId$ = "CAR"
Dim H As Object, S As Object, X64 As Object, JSON As Object, JSON1 As Object, JSON2 As Object, Key As Variant, Keys As Object, R%, c%, body$, sort$, test$, Subkey As Variant, Subkeys As Object, Subsubkey As Variant, Subsubkeys As Object
Set H = CreateObject("New:2087C2F4-2cef-4953-A8AB-66779B670495")

H.SetAutoLogonPolicy 0
H.SetTimeouts 0, 0, 0, 0
H.Open "GET", "https://apple-orange.banana.com/shop/rms/resourceallocation/"
H.send

body = "jsonObj=%7B%22nodeId%22%3A%22PRG2%22%2C%22searchTime%22%3A%22%22%2C%22entity%22%3A%22getLaneSFMap%22%7D"

With H
    .Open "POST", "https://apple-orange.banana.com/shop/rms/getdata"
    .setRequestHeader "Host", "apple-orange.banana.com"
    .setRequestHeader "Referer", "https://apple-orange.banana.com/shop/rms/resourceallocation/"
    .setRequestHeader "Accept-Language", "en-US,en;q=0.5"
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send body
End With

Sheets("Test2").Cells.ClearContents

#If Win64 Then
Set X64 = x64Solution()
X64.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function", "VBScript"
Set S = X64.CreateObjectx86("MSScriptControl.ScriptControl")
#Else
Set S = CreateObject("ScriptControl")
#End If

S.Language = "JScript"
S.AddCode "function keys(O) { var k = new Array(); for (var x in O) { k.push(x); } return k; } "

Set JSON = CallByName(CallByName(CallByName(S.Eval("(" & H.ResponseText & ")"), "result", VbGet), "getLaneSFMapOutput", VbGet), "LaneSFMap", VbGet)
Set Keys = S.Run("keys", JSON)

For Each Key In Keys
    On Error Resume Next
    Set JSON1 = CallByName(JSON, Key, VbGet)
    Set Subkeys = S.Run("keys", JSON1)
    For Each Subkey In Subkeys
        Set JSON2 = CallByName(JSON1, Subkey, VbGet)
        Set Subsubkeys = S.Run("keys", JSON2)
        For Each Subsubkey In Subsubkeys
            With Sheets("Test2")
                .Cells(2 + R, 2) = Subkey
                .Cells(2 + R, 1) = CallByName(CallByName(CallByName(CallByName(JSON2, Subsubkey, VbGet), "resources", VbGet), "0", VbGet), "label", VbGet)
                .Cells(2 + R, 3) = Date
            End With
            R = R + 1
        Next Subsubkey
    Next Subkey
Next Key

End Sub