VBA代码可从网站（ASP.NET）抓取数据

Question

有这个网站：https://mwatch.boursakuwait.com.kw/default.aspx/AllShares

有一个要导入到Excel工作簿中的股市表。

我在网站上找到此代码，并尝试对其进行编辑：

Option Explicit
Sub gethtmltable()
Dim objWeb As QueryTable

Set objWeb = ActiveSheet.QueryTables.Add( _
Connection:="URL;https://mwatch.boursakuwait.com.kw/default.aspx/AllShares", _
Destination:=Range("A1"))

With objWeb

.WebSelectionType = xlSpecifiedTables
.WebTables = "1"
.Refresh BackgroundQuery:=False
.SaveData = True
End With
End Sub

我收到一条消息，指出查询未返回任何数据。

有人可以帮忙吗？我在iMac上使用的是最新版本的Excel。

没有“从网站导入数据”选项。

Answer 1

Windows计算机：

正如有人提到的那样，有一个POST请求返回了可以解析的JSON。返回的字典的布局很怪异，因此您需要花费时间进行调查。我使用json解析器（jsonconverter.bas），将其添加到您的项目后，还需要转到VBE>工具>引用>添加对Microsoft脚本运行时的引用。

Option Explicit
Public Sub GetInfo()
    Dim sResponse As String, json As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST ", "https://mwatch.boursakuwait.com.kw/default.aspx/getData", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .setRequestHeader "Content-Type", "application/json; charset=utf-8"
        .send
        sResponse = .responseText
    End With
    Set json = JsonConverter.ParseJson(sResponse) 'dictionary
    'handle code
    Stop
End Sub

如果打印JSON（“ d”），则会得到一个字符串，其中包含清晰的项目：

示例：

---

如果要在Internet Explorer中使用定时循环，请参见以下示例：

Option Explicit

Public Sub GetInfo()
    Dim ie As New InternetExplorer, t As Date, table As Object, clipboard As Object, ws As Worksheet
    Const MAX_WAIT_SEC As Long = 20
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With ie
        .Visible = True
        .Navigate2 "https://mwatch.boursakuwait.com.kw/default.aspx/AllShares"

        While .Busy Or .readyState < 4: DoEvents: Wend

        t = Timer
        Do
            DoEvents
            On Error Resume Next
            Set table = ie.document.querySelector("#tblMarketData")
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While InStr(.document.body.innerHTML, "No data available in table") > 0
        If Not table Is Nothing Then
            Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            clipboard.SetText table.outerHTML
            clipboard.PutInClipboard
            ws.Cells(1, 1).PasteSpecial
        End If
        .Quit
    End With
End Sub

Mac：

我会切换语言。例如python。如果需要，我很乐意为此添加脚本。