Функция GetQueryRange предназначена для автоматизации загрузки данных с веб-страниц.

Например, нам надо из макроса Excel получить данные с нескольких однотипных страниц сайта.

Самый простой способ достичь этого - выполнять почти идентичные веб-запросы (где незначительно отличаться будет только URL страницы),
каждый раз анализируя данные, загруженные веб-запросом на лист Excel

Поскольку количество обращений ко мне, с просьбами сделать программу загрузки данных из интернета , с каждым днём растёт, я решил сделать для этих целей универсальную функцию:

Sub ПримерИспользования()

Dim ra As Range: On Error Resume Next

Set ra = GetQueryRange("http://ExcelVBA.ru/", 6)

Debug.Print ra.Address ' переменная ra содержит ссылку на диапазон ячеек $A$1:$C$15,

' содержащий данные 6-й таблицы главной страницы сайта ExcelVBA.ru

Set ra = GetQueryRange("http://excelvba.ru/sitemap.xml")

Debug.Print ra.Address ' теперь переменная ra содержит ссылку на диапазон ячеек $A$1:$D$502,

' содержащий данные карты сайта ExcelVBA.ru

End Sub

При запуске функции, создаётся скрытый лист с именем «tmpWQ» (если такой лист уже есть - используется существующий), и на этом листе выполняется веб-запрос к указанному сайту.

В качестве параметра можно задать номер интересующей нас таблицы сайта.

Номер (или номера) требуемых страниц можно узнать, записав макрорекордером код веб-запроса к нужной веб-странице.

Функция загружает данные на лист в формате HTML, - соответственно, мы можем получить доступ к гиперссылкам в результатах веб-запроса.

В большинстве случаев, эту функцию требуется использовать внутри цикла, формируя в теле цикла очередной URL, затем выполняя запрос к сформированному URL, получая необходимые данные с листа Excel, и т.д. для каждой из ссылок:

Sub ЗагрузкаСпискаТемСФорума_ПланетаExcel()

Dim ra As Range, cell As Range, n As Long: On Error Resume Next

For i = 1 To 10

' формируем ссылку

URL$ = "http://www.planetaexcel.ru/forum.php?forum_id=129&page_forum=" & i

Set ra = GetQueryRange(URL$, 6) ' выполняем веб-запрос

' перебирая ячейки таблицы-результата, выводим список тем в окно Immediate

For Each cell In ra.Columns(2).Cells

If cell.Hyperlinks.Count Then

n = n + 1: Debug.Print "Тема №" & n, cell.Text

Debug.Print "Ссылка на тему: " & cell.Hyperlinks(1).Address: Debug.Print

End If

Next cell

Next i

End Sub

Скриншот результата этого макроса:

Код функции GetQueryRange:

Function GetQueryRange(ByVal SearchLink$, Optional ByVal Tables$) As Range

On Error Resume Next: Err.Clear

Dim tmpSheet As Worksheet: Set tmpSheet = ThisWorkbook.Worksheets("tmpWQ")

If tmpSheet Is Nothing Then

Application.ScreenUpdating = False

Set tmpSheet = ThisWorkbook.Worksheets.Add

tmpSheet.Name = "tmpWQ"

tmpSheet.Visible = xlSheetVeryHidden

End If

If tmpSheet Is Nothing Then

msg$ = "Не удалось добавить скрытый лист «tmpWQ» в файл программы"

MsgBox msg, vbCritical, "Невозможно выполнить запрос к сайту": End

End If

tmpSheet.Cells.Delete: DoEvents: Err.Clear

With tmpSheet.QueryTables.Add("URL;" & SearchLink$, tmpSheet.Range("A1"))

If Len(Tables$) Then

.WebSelectionType = xlSpecifiedTables

.WebTables = Tables$

Else

.WebSelectionType = xlEntirePage

End If

.FillAdjacentFormulas = False: .PreserveFormatting = True

.RefreshOnFileOpen = False: DoEvents

.WebFormatting = xlWebFormattingAll

.Refresh BackgroundQuery:=False: DoEvents

If Err = 0 Then Set GetQueryRange = tmpSheet.UsedRange

.Delete: DoEvents

End With

End Function