Reputation: 69
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
Upvotes: 1
Views: 1401
Reputation: 84475
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):
Upvotes: 1