Why does this JSON Microsoft Script VBA code work in Excel 2016 but takes forever in 2019?

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
160
Office Version
  1. 2016
Platform
  1. Windows
I have this JSON Microsoft Scripting VBA code that pulls data from a work website into Excel. Can pull about 55,000 rows of data. About 5 columns of data. On 2016 the code worked fine but on 2019, which I need the code on, it takes forever to run or crashes Excel. I then have to quit Excel. I even upped my RAM and it did not help. How can this be edited to work? I even have Ludicrous mode enabled to turn off calculations, events, etc. Thank you in advance.

VBA Code:
Private Sub Pull_Shipments()

   Call LudicrousMode(True)

    Dim obj_http As Object, Json As Object, JSON1 As Object, x64 As Object, s As Object, key, keyring As Object, arr(),
 JSON2, SCC_Response As Object,
    inner_key, inner_keyring

    Set obj_http =

  CreateObject("WinHTTP.WinHTTPRequest.5.1")

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


  Vrid_col = 3

  site = UCase(Sheets("Main").Range("B30"))

  'Reset info
   With Sheets("Shipments")
Row = 2
.Range("A:H").ClearContents

'set headers
.Cells(1, 1) = "Truck"
.Cells(1, 2) = "Tracking ID"
.Cells(1, 3) = "State"
.Cells(1, 4) = "Size"
.Cells(1, 5) = "Area"
.Cells(1, 6) = "Section"
.Cells(1, 7) = "Date"
.Cells(1, 8) = "Cycle"

'Set URLs
SC_URL = "work website "
API_URL = "work website"

'request SCC Get
obj_http.Open "GET", SC_URL
obj_http.SetAutoLogonPolicy 0
obj_http.setRequestHeader "Food", FoodJar
obj_http.send
obj_http.WaitForResponse

For line_haul = 2 To Application.CountA(Sheets("Site Trucks").Columns(2 + Vrid_col))
    haul_id = Sheets("Site Trucks").Cells(line_haul, 1 + Vrid_col)
    package_body = "{""resourcePath"":""/ivs/getPackageList"",""httpMethod"":""post"",""processName"":""induct"",""requestBody"":{""nodeId"":""" & site & """,""Truck"":""" & haul_id & """,""status"":""ALL"",""filters"":{""Cycle"":[],""Date"":[],""OtherAttributes"":[],""Section"":[],""Size"":[]}}}"
 
    'Post APU request
    obj_http.Open "POST", API_URL
    obj_http.setRequestHeader "Cookie", CookieJar
    obj_http.SetClientCertificate "CURRENT_USER\MY\" & Environ("USERNAME")
    obj_http.SetAutoLogonPolicy 0
    obj_http.setRequestHeader "Accept", "*/*"
    obj_http.setRequestHeader "Content-Type", "application/json"
    obj_http.send package_body
 
    Set SCC_Response = s.Eval("(" & obj_http.responseText & ")")
    Set Json = CallByName(SCC_Response, "packageList", VbGet)
    Set keyring = s.Run("keys", Json)

        'parse vehicle info
        For Each key In keyring
            .Cells(Row, 1) = haul_id
            .Cells(Row, 2) = CallByName(CallByName(Json, key, VbGet), "ID", VbGet)
            .Cells(Row, 3) = CallByName(CallByName(Json, key, VbGet), "state", VbGet)
            .Cells(Row, 4) = CallByName(CallByName(Json, key, VbGet), "size", VbGet)
            .Cells(Row, 6) = CallByName(CallByName(Json, key, VbGet), "section", VbGet)
            .Cells(Row, 7) = CallByName(CallByName(Json, key, VbGet), "date", VbGet)
            .Cells(Row, 8) = CallByName(CallByName(Json, key, VbGet), "cycle", VbGet)
      
            If CallByName(CallByName(Json, key, VbGet), "Area", VbGet) <> "" Then
                .Cells(Row, 5) = Split(CallByName(CallByName(Json, key, VbGet), "Area", VbGet), ".")(0)
            End If
            Row = Row + 1
        Next key
 
Next line_haul
End With

 Call LudicrousMode(False)

End Sub
 
It will be the response you get from POST call that you've referenced in this line:
VBA Code:
 Set SCC_Response = s.Eval("(" & obj_http.responseText & ")")
IF youo then add the two following lines, it should print out the JSON string to the Immediate Window:
VBA Code:
JSONString  = obj_http.responseText
Debug.Print JSONString
 
Upvote 0

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
It will be the response you get from POST call that you've referenced in this line:
VBA Code:
 Set SCC_Response = s.Eval("(" & obj_http.responseText & ")")
IF youo then add the two following lines, it should print out the JSON string to the Immediate Window:
VBA Code:
JSONString  = obj_http.responseText
Debug.Print JSONString

It just repeats [object Object],[object Object],
 
Upvote 0
?‍♂️

Well there must be a JSON string, because otherwise it would never have worked at all. There would be no data to populate your spreadsheet with.
 
Upvote 0
?‍♂️

Well there must be a JSON string, because otherwise it would never have worked at all. There would be no data to populate your spreadsheet with.
Typo sorry. When I add that line and I get an error for “invalid procedure call or argument” on food and foodjar line
 
Upvote 0
There were two lines of code, but I'm confused now - where are you putting them? They should be after that line of code I identified in my post above, and nowhere near the food and foodjar variable used in the first (GET) request. I still don't understand why that request is being made.
 
Upvote 0
There were two lines of code, but I'm confused now - where are you putting them? They should be after that line of code I identified in my post above, and nowhere near the food and foodjar variable used in the first (GET) request. I still don't understand why that request is being made.
I put them exactly where you showed me. Also that request is being made because it gives me that authentication to access the site that was verified when I entered in my password from another VBA code that is ran before
 
Upvote 0
There were two lines of code, but I'm confused now - where are you putting them? They should be after that line of code I identified in my post above, and nowhere near the food and foodjar variable used in the first (GET) request. I still don't understand why that request is being made.
Also I just got the code to work fast back to back now by once again creating a new workbook and only putting in the codes and sheets and nothing else. However, after I save the file to either .xlsm or .xlsb (which I think are my only two options) it goes back to taking forever. Really strange. I’m trying it now running from my personal workbook on a blank sheet but it takes forever also.
 
Upvote 0
Can you repost the updated code here please?
Also that request is being made because it gives me that authentication to access the site that was verified when I entered in my password from another VBA code that is ran before
I suspected that might be the case, but it's very odd means of authentication. You're arguably doing the actually authentication in second POST request when you are providing the cookie info and the client certificate with your username, but oh well. I looked into the Scriptcontrol point, and sure enough, you can call the Tabacus replacement for it in the same way, so I was 'wrong' there too. It's not uncommon for me to be wrong. :-)
 
Upvote 0
Can you repost the updated code here please?

I suspected that might be the case, but it's very odd means of authentication. You're arguably doing the actually authentication in second POST request when you are providing the cookie info and the client certificate with your username, but oh well. I looked into the Scriptcontrol point, and sure enough, you can call the Tabacus replacement for it in the same way, so I was 'wrong' there too. It's not uncommon for me to be wrong. :)
Yes, will look to do that. And okay I finally found some consistency! So it for sure does work fast on a new blank workbook only when the codes are in the actual workbook. Just tried it again. Also I cannot close and reopen it. Do you happen to know why?
 
Upvote 0
You can't close and reopen the workbook?!? I've never heard of such a thing.

Hang on - So you're saying that you can close it, but you can't then reopen the closed workbook....? At all? Not even in safe mode? Does it have a lot of data in it? Does it present an error message at all?

So many questions....
 
Upvote 0

Forum statistics

Threads
1,224,816
Messages
6,181,138
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top