mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Функция импорта данных из HTML файлов

Функция FileQueryRange предназначена для импорта данных из файлов HTML

Например, если нам надо макросом Excel получить данные из писем, созданных в HTML формате, то эта функция как раз нам и поможет

Эта функция, по сути, аналогична другой - GetQueryRange, с тем лишь различием, что GetQueryRange работает с веб-страницами (исходными данными является гиперссылка, ведущая в интернет), а описываемая в этой статье FileQueryRange принимает в качестве параметра имя файла, расположенного на локальном компьютере.

Код функции импорта данных из HTML файла:

Function FileQueryRange(ByVal filename$, Optional ByVal Tables$) As Range
    ' функция загружает HTML файл filename$
    ' на скрытый лист tmpWQ (при его отсутствии - лист создаётся)
    ' возвращает диапазон ячеек, заполненный импортированными данными
    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;file:///" & Replace(filename$, " ", "%20"), tmpSheet.Range("A1"))
        If Len(Tables$) Then
            .WebSelectionType = xlSpecifiedTables
            .WebTables = Tables$
        Else
            .WebSelectionType = xlEntirePage
        End If
        .FillAdjacentFormulas = False: .PreserveFormatting = True
        .RefreshOnFileOpen = False: DoEvents
        .WebFormatting = xlWebFormattingNone    ' или xlWebFormattingAll
        .Refresh BackgroundQuery:=False: DoEvents
        If Err = 0 Then Set FileQueryRange = tmpSheet.UsedRange
        .Delete: DoEvents
    End With
End Function

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
                     _                      _    
_ __ __ __ / \ _ _ _ __ | | __
| '_ \ \ \ / / / _ \ | | | | | '_ \ | |/ /
| |_) | \ V / / ___ \ | |_| | | | | | | <
| .__/ \_/ /_/ \_\ \__, | |_| |_| |_|\_\
|_| |___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.