Код VBA для получения данных с веб-сайта (ASP.NET) - PullRequest
Новая
       19

Код VBA для получения данных с веб-сайта (ASP.NET)

0 голосов
/ 28 декабря 2018

Вот этот веб-сайт: 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

Я получаю сообщение о том, что запрос не дал данных.

Может кто-нибудь помочь?Я использую последнюю версию Excel на iMac.

Нет опции «Импортировать данные с веб-сайта».

1 Ответ

0 голосов
/ 28 декабря 2018

Windows-машина:

Как уже упоминалось, сделан запрос POST, который возвращает JSON, который вы можете проанализировать.Возвращенный словарь имеет странную разметку, поэтому вам придется потратить на это время.Я использую парсер json (jsonconverter.bas), который после добавления в ваш проект вам также нужно перейти в VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime. 

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») вы получите строку, которая очищает элементы:

Пример:

image

Если вы хотите использовать синхронизированный цикл с 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:

Я бы поменял языки.Например к питону.Я рад добавить сценарий для этого при желании.

...