Инструмент веб-запросов Excel не способен сохранять ранее извлеченные данные.
Однако, используя VBA, довольно легко автоматически копировать данные из таблицы запросов в Excel каждый раз, когда веб-запрос обновляет их.
Выполните следующие шаги, чтобы настроить рабочую книгу для демонстрации техники:
1) Создайте новую рабочую книгу с двумя рабочими листами , WebQuery
и USD
.
2) Выберите ячейку A1
листа WebQuery
и запустите новый веб-запрос, используя адрес https://www.xe.com/currencyconverter/
.
3) Прокрутите вниз до таблицы XE Live Exchange Rates и импортируйте ее.
4) В модуле ThisWorkbook
добавьте этот код:
'============================================================================================
' Module : ThisWorkbook
' Version : 0.1.0
' Part : 1 of 2
' References : N/A
' Source : https://superuser.com/a/1331097/763880
'============================================================================================
Option Explicit
Private qtExchangeRates As New clsQueryTable
Private Sub Workbook_Open()
qtExchangeRates.InitEvents Worksheets("WebQuery").QueryTables(1)
End Sub
5) Создайте новый модуль класса с именем clsQueryTable
и поместите в него этот код:
'============================================================================================
' Module : Class Module clsQueryTable
' Version : 0.1.0
' Part : 2 of 2
' References : N/A
' Source : https://superuser.com/a/1331097/763880
'============================================================================================
Option Explicit
Public WithEvents QueryTable As QueryTable
Private Sub QueryTable_AfterRefresh(ByVal Success As Boolean)
If Success Then
Dim varUSDExchangeRates As Variant
varUSDExchangeRates = Me.QueryTable.WorkbookConnection.Ranges(1).Columns(2).Value2
varUSDExchangeRates(LBound(varUSDExchangeRates), 1) = Now
Worksheets("USD").Range("A1").Offset(Rows.Count - 1).End(xlUp).Offset(1) _
.Resize(ColumnSize:=1 + UBound(varUSDExchangeRates) - LBound(varUSDExchangeRates)) _
= Excel.WorksheetFunction.Transpose(varUSDExchangeRates)
Else
' Query failed or was cancelled
End If
End Sub
Sub InitEvents(QueryTable As Object)
Set Me.QueryTable = QueryTable
End Sub
6) Настройте веб-запрос на автоматическое обновление каждую минуту.
7) Сохраните и закройте книгу
При повторном открытии книги веб-запрос будет обновляться каждую минуту, а первый столбец данных таблицы курсов обмена валют XE (текущие курсы обмена долларов США) будет сохраняться в листе USD
.
Эта демонстрация просто извлекает один столбец данных, но любые / все данные таблицы могут быть скопированы таким же образом.
Обратите внимание, что демонстрационная версия будет работать правильно с любой таблицей с любого URL-адреса, поскольку код автоматически подстраивается под размер таблицы.