request using VBA with JSON response

Question

I am coding through VBA-WEB, VBA-REST, etc. I refer to VBA and coding related homepage.

https://www.marketscreener.com

I think I should have a COOKIE value after signing in and logging into my homepage.

https://www.marketscreener.com/stock-exchange/shares/North-America-8/United-States-12/

I would like to import the data values ​​from the image below into Excel.

Lists of companies belonging to category[ Company/Price/Capitalization/1st Jan% Sector]

I've been working hard with VBA-WEB, VBA-REST..BUT..   0 # - #

Only these results are displayed. I did not know what was wrong, so I got a request. It is a level that only VBA is learned very little because it does not know because it is a coding starter.

Sheets (1) .Cells (2, 1) .Value is as follows.

{"Req":{"TRBC":0,"TRBC_chain":[""],"aSectors":[{},{},{},{},{}],"markets":[12],"capi_min":0,"capi_max":10,"liqu_min":0,"liqu_max":10,"tri":[0,1,2,3,4,5],"ord":["N","N","N","D","N","N"],"special_option_news":"","special_option_date":"","special_dynamic":"","special_partner":"","result_mode":7,"crit":[],"page":2},"bJSON":"true"}

parameters is as follows.

https://www.marketscreener.com/outils/mods_a/moteurs_results.php?ResultMode=7&model=3&

I do not know what is wrong. I am a beginner in VBA and would appreciate your specific modification.

---

Dim MyntraClient As New RestClient
MyntraClient.BaseUrl = "https://www.marketscreener.com/"

'With inline JSON
Dim json As String

 json = Sheets (1) .Cells (2, 1) .Value

Dim Response As RestResponse

Set Response = MyntraClient.PostJSON ("stock-exchange / shares / North-America-8 / United States-12 /

'It's no fun creating json string by hand, instead of create it via Dictionary / Collection / Array

Dim SearchParameters As New Dictionary

SearchParameters.Add "TRBC", 0
SearchParameters.Add "TRBC_chain", Array ("")
SearchParameters.Add "aSectors", Array ("{}", "{}", "{}", "{}", "{}"
SearchParameters.Add "markets", Array (12)
SearchParameters.Add "capi_min", 0
SearchParameters.Add "capi_max", 10
SearchParameters.Add "liqu_min", 0
SearchParameters.Add "liqu_max", 10
SearchParameters.Add "tri", Array (0, 1, 2, 3, 4, 5) '"[0,1,2,3,4,5]"
SearchParameters.Add "ord", Array ("N", "N", "N", "D", "N" N "", "" D "", "" N "", "" N ""] "
SearchParameters.Add "special_option_news", "" ""
SearchParameters.Add "special_option_date", "" ""
SearchParameters.Add "special_dynamic", "" ""
SearchParameters.Add "special_partner", "" ""
SearchParameters.Add "result_mode", 7
SearchParameters.Add "crit", Array ()
SearchParameters.Add "page", 1
SearchParameters.Add "bJSON", True

Set Response = MyntraClient.PostJSON ("outils / mods_a / moteurs_results.php? ResultMode = 7 & model = 3 &", Array (SearchParameters))

'Check status, received content, or do something with the data directly
Debug.Print Response.StatusCode
Debug.Print Response.Content
Sheets (1) .Cells (3, 1) .Value = Response.StatusCode
Sheets (1) .Cells (4, 1) .Value = Response.Content

---

enter image description here

Answer 1

I used fiddler to monitor the web traffic when making that page selection from the landing page (page2). I used that info to generate an XMLHTTP Post request.

I put the following in sheet 1 cell A1 to save on escaping characters in the code.

{"TRBC":0,"TRBC_chain":[""],"aSectors":[{},{},{},{},{}],"markets":[12],"capi_min":0,"capi_max":10,"liqu_min":0,"liqu_max":10,"tri":[0,1,2,3,4,5],"ord":["N","N","N","D","N","N"],"special_option_news":"","special_option_date":"","special_dynamic":"","special_partner":"","result_mode":7,"crit":[],"page":2}

Then used the following code:

Option Explicit
Public Sub GetTable()
    Dim sResponse As String, html As New HTMLDocument, hTable As HTMLTable
    Dim http As New MSXML2.XMLHTTP60, body As String, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    body = "Req=" & ws.Range("A1")
    body = body & "&bJSON=true"

    With http
        .Open "POST", "https://www.marketscreener.com/outils/mods_a/moteurs_results.php?ResultMode=7&model=3&undefined, False"
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send body
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    With html
        .body.innerHTML = sResponse
        Set hTable = .getElementById("ZBS_restab_2b")
    End With
    WriteTable hTable, 2, ws
End Sub

Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet
    Dim tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long
    r = startRow
    With ws
        Set tRow = hTable.getElementsByTagName("tr")
        For Each tr In tRow
            r = r + 1
            Set tCell = tr.getElementsByTagName("td")
            c = 1
            For Each td In tCell
                .Cells(r, c).Value = td.innerText
                c = c + 1
            Next td
        Next tr
    End With
End Sub

---

Sample results:

---

References (VBE > Tools > References):

1. Microsoft HTML Object Library
2. Microsoft XML, V6.0 'For my Excel 2016 version