Excel VBA JSON issue

[TrainerBlue]

Hi I'm coming across an issue where part of a VBA code isn't loading in one file while it is in another. I get error 424 and it highlights the code "Set Parsed = JsonConverter.ParseJson(.responseText)". Not sure exactly what the issue is. There is a separate module that is called JsonConverter and I have it imported to the file where it isn't working. Not 100% what's wrong, any help would be lovely

Sub Amnesty()

    Dim a$, Parsed As Object, ws As Worksheet
    Dim utcDate As Date, utcDiff As Double
    Dim j, k As Long
    Dim lte, gte As Variant
    Dim holder, item As Variant
    Dim l As Double
    Dim Site As String
    Dim BeginTime, EndTime
    Dim UsedRows As Integer
    
    j = 1
    k = 1
    Set ws = Sheet9
    
    Application.Calculation = xlCalculationManual
    
    BeginTime = Sheet3.[N23].Value
    EndTime = BeginTime + 7
    Site = Sheet3.[T2].Value
    utcDiff = Sheet3.[AC1].Value / 24
     
    UsedRows = Application.WorksheetFunction.CountA(ws.Range("A:A"))
    
    If UsedRows > 1 Then
        ws.Range("A2:K" & UsedRows).Cells.ClearContents
    End If
        
    gte = (BeginTime - 25569 - utcDiff) * 86400000
    lte = (EndTime - 25569 - utcDiff) * 86400000
    
    a = "{""index"":""quality_intelligence_amnesty"",""ignore_unavailable"":true}" & Chr(10)
    a = a & "{""size"":100000,""sort"":[{""last_updated_date"":{""order"":""desc"",""unmapped_type"":""boolean""}}],""query"":{""filtered"":{""query"":{""query_string"":{""query"":""warehouse_id: " & Site & ""","
    a = a & """analyze_wildcard"":true}},""filter"":{""bool"":{""must"":[{""range"":{""created_date"":{""gte"":" & gte & ",""lte"":" & lte & "}}}]"
    a = a & ",""must_not"":[]}}}},""fields"":[""addback_user"",""addback_quantity"",""problem_status"",""fnsku"",""addback_pick_area"",""addback_location_id"",""source_defect_found""]"
    a = a & ",""fielddata_fields"":[""created_date""]}" & Chr(10)
    
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        '.SetAutoLogonPolicy 0
        .SetTimeouts 0, 0, 0, 0
        '.Open "GET", "https://midway-auth.amazon.com"
        '.setRequestHeader "Cookie", "session=" + GetMidwaySession()
        '.send
        .Open "GET", "https://qi-rpt-iad.iad.proxy.amazon.com/"
        .SetAutoLogonPolicy 0
        .Send
        .Open "POST", "https://qi-rpt-iad.iad.proxy.amazon.com/elasticsearch/_msearch?timeout=0&ignore_unavailable=true&preference=" & (Now() - 25569) * 86400 & "123"
        .Send a
        Set Parsed = JsonConverter.ParseJson(.ResponseText)
    End With
    
    For Each item In Parsed("responses")
        Set holder = item
    Next
    
    For Each item In holder("hits")("hits")
        k = k + 1
        For j = 1 To 7
            If item("fields").exists((ws.Cells(1, j).Value)) Then
                ws.Cells(k, j) = item("fields")(ws.Cells(1, j).Value)(1)
            Else
                ws.Cells(k, j) = ""
            End If
        Next
    Next
    
    Application.Calculate
    Application.Calculation = xlCalculationAutomatic
    
    ws.Range("H2").Value = "=IF(LEFT(E2,1)=""P"",""Bin"",""Container"")"
    ws.Range("H2").AutoFill Destination:=ws.Range("H2:H" & Application.WorksheetFunction.CountA(ws.Range("A:A")))
       
End Sub

 

[Dan_W]

Hi

The code itself looks ok, except that I'm not sure if the JSON code you've stored in variable a will work as properly formatted JSON. That said, I see it is being posted to a web server, so maybe you need to submit it that particular format. In any event, are you sure that the servers are running? I just tested the URLs in the code, and I'm getting an 12007 error - meaning that the URL cannot be resolved to an IP address (can't connect to it at all).

You'd be likely be getting an error because the .ResponseText that is being used as an input for the JsonConverter.ParseJson routine essentially doesn't exist.