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

VBA：从HTTPS下载数据

1 个答案: