Загрузка данных с веб-страницы (списка) в Excel

Question

Я должен загрузить данные отсюда:

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

Затем я должен сохранить все данные в Excel.Проблема в том, что мне нужно выбрать несколько дат и несколько валют.Например, я должен выбрать 31.12.2008, Долар, Евро и Песо.Более того, я должен выбрать одну валюту за раз, и у меня есть много для загрузки.Я пробовал импортировать внешние данные в 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