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
 
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....
No I am just saying to ensure the code will run fine. I create a new workbook. Put codes and sheets in there. I can run the code as many times and it will be fast.

However, if I save the file or close it and reopen it (saves it) the code will go back to running extremely slow. I’m not sure what the default format is of the workbook that gets created when you go to “open new workbook” but it works with the code. But the VBA has to be inside the workbook itself
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
OK - well, the VBA code doesn't need to be in the same workbook as the output.
If it is running slow, that may because the spreadsheet already has data in it? Though, that said, that should be dealt with by the Ludicrous routine...

One thing that will cause it to run slow is that fact that you are writing data to the spreadsheet in a loop. Everytime you 'touch' the spreadsheet, it slows everything down - there is a much quicker way of doing it - you can store it all in an array in memory, and then just 'drop' the array onto the worksheet - it populates the sheet nearly instantly. But the first step is extracting the data from the JSON string...
 
Upvote 0
OK - well, the VBA code doesn't need to be in the same workbook as the output.
If it is running slow, that may because the spreadsheet already has data in it? Though, that said, that should be dealt with by the Ludicrous routine...

One thing that will cause it to run slow is that fact that you are writing data to the spreadsheet in a loop. Everytime you 'touch' the spreadsheet, it slows everything down - there is a much quicker way of doing it - you can store it all in an array in memory, and then just 'drop' the array onto the worksheet - it populates the sheet nearly instantly. But the first step is extracting the data from the JSON string...
Yeah it’s so strange. So do you need the code that authenticates my access before I can get the JSON string? Seeing as I got that error. The only thing I added was those two lines you gave me
 
Upvote 0
Well, doesn't that include the line which is throwing the error? You said that it was this one:
VBA Code:
obj_http.setRequestHeader "Food", FoodJar
 
Upvote 0
In theory, it should be exactly the same as what you posted above, together with the two new lines of code, no?
 
Upvote 0
In theory, it should be exactly the same as what you posted above, together with the two new lines of code, no?
No these are two totally separate codes. As that one is a general one that gets me access to pull data from other work sites also.
 
Upvote 0
Huh? I'm talking about the Pull_Shipments subroutine. I gave you a line of code to print out the JSON string.
When I add that line and I get an error for “invalid procedure call or argument” on food and foodjar line
You then said that when you do add the code, it presents an error.
I've got some things I need to do this afternoon, so let me know when you've sorted this all out and you have the JSON string because I don't have a lot to work with here.
 
Upvote 0
Huh? I'm talking about the Pull_Shipments subroutine. I gave you a line of code to print out the JSON string.

You then said that when you do add the code, it presents an error.
I've got some things I need to do this afternoon, so let me know when you've sorted this all out and you have the JSON string because I don't have a lot to work with here.
Got it. Here is the JSON String

VBA Code:
{"packageList":[]}
 
Upvote 0
Nope - that is definitely not it. The JSON string will have all the data that it is you're populating the spreadsheet with. And that doesn't have any data in it.
From the code above, I know, for example, that it the JSON string wil have the words packageList, ID, State, Size,Section, Date, Cycle etc etc.

VBA Code:
.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

Your JSON string has none of those things. :-) I feel we're almost there.
 
Upvote 0

Forum statistics

Threads
1,224,816
Messages
6,181,141
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