Xtykutl

I have Excel macro that pulls data from an internal website but suddenly it stopped working and spits out "Object doesn't support this property or method." error.

Debugging marks the "Set JSON" row.

Any idea how to fix this error?

Thanks.

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