1

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

Improve this question

1 Answer 1

Reset to default
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:

enter image description here

References (VBE > Tools > References):

  1. Microsoft HTML Object Library
  2. Microsoft XML, V6.0 'For my Excel 2016 version
Improve this answer
Sign up to request clarification or add additional context in comments.

19 Comments

Another great xmlhttp answer.
QHarr..Thanks a lot..Sometimes, however, a runtime error occurs in Set headers = hTable.getElementsByTagName ("th"). How can I solve this problem?
Please see updated code. Any problems, please give me the failing jJSON string in A1.
I found the function to create a json string on the Internet. So, a1 of sheet1 is changed to sheet2! Aa2, and each key and value is inserted into each cell, and it is connected by function function
Ok, but how does that reflect on my answer to your original question? For the example you gave my code works I believe. Do you have a different string which is failing? Or is the failure due to this looping?
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.