Question

我正在通过VBA-WEB，VBA-REST等进行编码。我参考了VBA和与编码相关的主页。

https://www.marketscreener.com

我认为登录并登录首页后应该拥有一个COOKIE值。

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

我想将下面图片中的数据值导入Excel。

属于[[公司/价格/资本化/第一月1％]部门]类别的公司列表

我一直在努力处理VBA-WEB，VBA-REST..BUT .. 0＃-＃

仅显示这些结果。我不知道出什么问题了，所以我提出了要求。在这个级别上，很少学习VBA，因为不知道是因为它是一个编码入门者。

Sheets（1）.Cells（2，1）。值如下。

{“ Req”：{“ TRBC”：0，“ TRBC_chain”：[“”]，“ aSectors”：[{}，{}，{}，{}，{}]，“市场”：[ 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”}

参数如下。

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

我不知道怎么了。我是VBA的初学者，非常感谢您的特定修改。

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

从登陆页面（第2页）进行页面选择时，我使用了提琴手来监视网络流量。我使用该信息来生成XMLHTTP Post请求。

我将以下内容放在工作表1的单元格A1中，以节省代码中的转义字符。

{"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}

然后使用以下代码：

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

样本结果：

参考（VBE>工具>参考）：

Microsoft HTML对象库
Microsoft XML V6.0'对于我的Excel 2016版本

使用带有JSON响应的VBA请求

1 个答案: