VBA: СКАЧАТЬ ДАННЫЕ ИЗ HTTPS

Question

Я хочу скопировать все данные с этого https:

https://sslecal2.forexprostools.com/?columns=exc_flags,exc_currency,exc_importance,exc_actual,exc_forecast,exc_previous&features=datepicker,timezone,timeselector,filters&countries=29,32,27,37,72,22,17,10,35,7,125,26,4,5&calType=day&timeZone=7&lang=1

И вставьте его в Excel. Это создаст код VBA, который откроет эту ссылку, скопирует весь контент и вставит в лист. Я думал что-то как:

 Sub DownloadFile()

 Dim myURL As String
myURL = "https://sslecal2.forexprostools.com/?columns=exc_flags,exc_currency,exc_importance,exc_actual,exc_forecast,exc_previous&features=datepicker,timezone,timeselector,filters&countries=29,32,27,37,72,22,17,10,35,7,125,26,4,5&calType=day&timeZone=7&lang=1"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send

WinHttpReq.Select
Selection.Copy
Range("A20").Select
ActiveSheet.Paste

End Sub

Но это не работает. У кого-нибудь есть идея?

Спасибо вам за помощь!

Answer 1

Вы можете скопировать всю таблицу в буфер обмена, используя outerHTML элемента таблицы, а затем записать на лист

Option Explicit
Public Sub GetTable()
    Dim sResponse As String, html As New HTMLDocument, clipboard As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://sslecal2.forexprostools.com/?columns=exc_flags,exc_currency,exc_importance,exc_actual,exc_forecast,exc_previous&features=datepicker,timezone,timeselector,filters&countries=29,32,27,37,72,22,17,10,35,7,125,26,4,5&calType=day&timeZone=7&lang=1", False
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))

    With html
        .body.innerHTML = sResponse
        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        clipboard.SetText .querySelector("#ecEventsTable").outerHTML
        clipboard.PutInClipboard
        ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
    End With
End Sub