Question

我必须从此处下载数据：

[http://www.bcra.gov.ar/PublicacionesEstadisticas/Evolucion_moneda.asp][1]

然后，我必须将所有数据保存在Excel中。问题是我必须选择几种日期和几种货币。例如，我必须选择12/31/2018，Dolar，Euro和Pesos。而且，我必须一次选择一种货币，并且有很多可供下载。我尝试使用Excel导入外部数据，但是没有用。

我也尝试过使用此VBA代码

Sub descarga_monedas()

Fecha = "2018.06.05"
Moneda = 313

Path = "http://www.bcra.gob.ar/PublicacionesEstadisticas/Evolucion_moneda_3.asp?tipo=E&Fecha=" & Fecha & "&Moneda=" & Moneda & """"

Application.Workbooks.Open (Path)

End Sub

页面似乎阻止了此类代码。

有什么办法解决这个问题？

Answer 1

您可以通过以下方式进行操作。我已经获取了所有日期，但只包含了一个日期，可以与所有货币一起使用。在日期上添加另一个外部循环以添加日期值，即在inputDates集合上使用外部循环以获取每个日期。

Option Explicit  
Public Sub GetData()
    Dim  body As String, html As HTMLDocument, http As Object, i As Long
    Dim codes As Object, inputCurrency As Object, inputDates As Object, dates As Object
    Const BASE_URL As String = "http://www.bcra.gov.ar/PublicacionesEstadisticas/Evolucion_moneda_3.asp?tipo=E&"
    Set codes = CreateObject("scripting.dictionary")
    Set inputDates = New Collection
    Set html = New HTMLDocument                  '<== VBE > Tools > References > Microsoft HTML Object library
    Set http = CreateObject("MSXML2.XMLHTTP")
    With http
        .Open "GET", "http://www.bcra.gov.ar/PublicacionesEstadisticas/Evolucion_moneda.asp", False
        .send
        html.body.innerHTML = .responseText

        Set inputCurrency = html.querySelectorAll("[name=Moneda] option[value]")
        Set dates = html.querySelectorAll("[name=Fecha] option[value]")
        For i = 0 To inputCurrency.Length - 1
            codes(inputCurrency.item(i).innerText) = inputCurrency.item(i).Value
        Next
        For i = 0 To dates.Length - 1
            inputDates.Add dates.item(i).Value
        Next

        Dim fecha As String, moneda As String, key As Variant, downloadURL As String
        Dim clipboard As Object, ws As Worksheet

        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

        For Each key In codes.keys
            DoEvents
            fecha = inputDates.item(1) '<== use an outer loop over inputDates collection to get each date
            moneda = key
            downloadURL = BASE_URL & "Fecha=" & fecha & "&Moneda=" & moneda '2019.02.11 ,79

            .Open "GET", downloadURL, False
            .send
            html.body.innerHTML = StrConv(http.responseBody, vbUnicode)

            clipboard.SetText html.querySelector("table").outerHTML
            clipboard.PutInClipboard

            Set ws = ThisWorkbook.Worksheets.Add
            ws.NAME = fecha & "_" & moneda
            ws.Cells(1, 1).PasteSpecial
        Next
    End With
End Sub

将数据从网页（列表）下载到Excel

1 个答案: