Получение данных веб страницы

[Diamock]

Здравствуйте Уважаемые! Вопрос теоретический.
Имеется веб страница (обозначим её условно: имясайта.ru/index.htm).
На странице помещено несколько ComboBox и TextBox.
При выборе значения в ComboBox, TextBox отображает текстовые данные.
Вопрос в следующем:
Возможно ли считать данные из ComboBox на веб странице, и поместить в ComboBox на форме?

[MIT]

Возможно.

[Diamock]

Возможно.

Спасибо за ответ, буду экспериментировать.

[Diamock]

Рассмотрев html код веб страницы в MS FP, я обнаружил следующее:
Данные помещённые в ComboBox, находяться между тегами

Код: Выделить всё

<TD><SELECT....>   </SELECT> </TD>

Сначала идёт описание ComboBox, а потом помещённые в него данные.

Код: Выделить всё

<OPTION value=XXXXXX>000, AAAAA 0000000000</OPTION>

Если я правильно понял код, то при выборе значения ComboBox "AAAAA 0000000000", в текстовом поле появляется следующее "XXXXXX".

Для того, что бы мне отобразить эти данные на моей форме, я думаю следовать следующему алгоритму:
1). Загрузить веб страницу в не видимый на форме TextBox, как текстовые данные.
2). Найти требуемый кусок текста и скопировать его во второй невидимый TextBox.
3). Привести текст во втором TextBox к следующему виду, что бы каждая его строка была такова

Код: Выделить всё

<OPTION value=XXXXXX>000, AAAAA 0000000000</OPTION>

4). Сохранить данные в текстовый файл на винчестер.
5). Считать построчно данные из текстового файла, выделяя в каждой строке значение "XXXXXX" и помещая его в третий невидимый TextBox, выделяя значение "AAAAA 0000000000" и помещая его в Combobox.
6). Сохранить данные третьего TextBox в текстовый файл на винчестер, прочитать его построчно, создать массив и загрузить в него каждую строку из этого файла.
7). При выборе значения ComboBox, загружать в TextBox данные из массива по индексу.

Если я ошибся, объясните где и почему.
Прошу извинить за немного корявый стиль изложения.

[MIT]

Ну так-то оно, конечно, возможно даже и заработает, но это совсем неверный способ, каждый его пункт категорически кривой, так делать не стоит.
Расово верный способ следующий: грузим страницу при помощи WinHTTP (в поиск по форуму - обсуждалось много раз) в переменную (а не в текстбокс, зачем он вообще?), затем из модели DOM (тоже в поиск) достаем нужные данные.

[Diamock]

Уважаемый Mit, спасибо за конструктивный комментарий. Буду изучать и пробовать.

[Diamock]

И снова здравствуйте Уважаемые!
В кирпичах нашёл класс Tyomitch'а, качалка. Это - то, что нужно, но есть в нем одна особенность. В html коде буквы кириллицы, отображаются кракозябрами, следующего вида:

Код: Выделить всё

<div id="bot_text">«Доктор Веб» — росс....... доверия к продуктам компании.</div>

Подскажите, это можно исправить? Или потребуется целиком переделывать класс?

[Хакер]

Исправить надо свой мозг, полностью прочитав эту статью.

[Diamock]

Исправить надо свой мозг, полностью прочитав эту статью.

И, снова спасибо Хакеру за пинок в нужном направлении. Буду исправлять и мозг и код соответственно. А не пойму, попрошу помощи.

[Diamock]

Здравствуйте Уважаемые! Мозг исправлению поддался, но с трудом...
С помощью поиска, на конференции нашёл следующий код:

Код: Выделить всё

Private Declare Function LocalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
' Constants
Private Const CP_UTF8 As Long = 65001
Private Const LMEM_ZEROINIT As Long = &H40

'--------------------------------------------------------------------------------
' Проект : OfflineClient
' Процедура : WinToUTF8
' Описание : Перевод строки в UTF8 кодировку
' Кем создан : SNE
' Дата-Время : 09.11.2004-11:52:01
'
' Параметры : inString - Строка, в win кодировке
' lMaxSize - Максимальный размер строки
'--------------------------------------------------------------------------------
Function WinToUTF8(ByRef inString As String, _
ByVal lMaxSize As Long) As String

Dim hMemLock1 As Long, hMemLock2 As Long
Dim iStrSize As Long

hMemLock1 = LocalAlloc(LMEM_ZEROINIT, lMaxSize)
hMemLock2 = LocalAlloc(LMEM_ZEROINIT, lMaxSize)

iStrSize = MultiByteToWideChar(0&, 0&, inString, &HFFFF, hMemLock1, lMaxSize)
iStrSize = WideCharToMultiByte(65001, 0&, hMemLock1, iStrSize, hMemLock2, lMaxSize, 0&, 0&) ' CP_UTF8

If Len(iStrSize) Then
WinToUTF8 = String$(iStrSize, 0&)
Call CopyMemory(ByVal WinToUTF8, ByVal hMemLock2, iStrSize)
End If

Call LocalFree(hMemLock1)
Call LocalFree(hMemLock2)
End Function

'--------------------------------------------------------------------------------
' Проект : OfflineClient
' Процедура : UTF8ToWin
' Описание : Перевод UTF8 строки в WIN кодировку
' Кем создан : SNE
' Дата-Время : 09.11.2004-11:56:58
'
' Параметры : inString - Строка в utf8 кодировке
' lMaxSize - Максимальный размер строки
'--------------------------------------------------------------------------------
Function UTF8ToWin(ByRef inString As String, _
ByVal lMaxSize As Long) As String

Dim hMemLock1 As Long, hMemLock2 As Long
Dim iStrSize As Long

hMemLock1 = LocalAlloc(LMEM_ZEROINIT, lMaxSize)
hMemLock2 = LocalAlloc(LMEM_ZEROINIT, lMaxSize)

iStrSize = MultiByteToWideChar(CP_UTF8, 0&, inString, &HFFFF, hMemLock1, lMaxSize)
iStrSize = WideCharToMultiByte(0&, 0&, hMemLock1, &HFFFF, hMemLock2, iStrSize, 0&, 0&)

If Len(iStrSize) Then
UTF8ToWin = String$(iStrSize, 0&)
Call CopyMemory(ByVal UTF8ToWin, ByVal hMemLock2, iStrSize)
End If

Call LocalFree(hMemLock1)
Call LocalFree(hMemLock2)
End Function

Он прекрасно работает. Не могу понять аргумент lMaxSize - Максимальный размер строки.
Как его получить?
Вероятно с помощью функции Len или LenB?
И как перевести это в Long?

[Хакер]

Это не мозг поддался, а буфер обмена, мизинец (Ctrl) и указательный палец (+V) поддались искушению копипаста.

Сможешь объяснить, почему используются именно Local-функции?

[Хакер]

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

[Diamock]

Сможешь объяснить, почему используются именно Local-функции?

Нет. Объяснить не смогу. Статью прочитал два раза, но ясности не добавилось.
Уважаемый Хакер! Если вам не трудно, расскажите почему код кривой и, что значит Local-функция.
Заранее спасибо.

P.s. Или ткните носом, где можно почитать основы, чтобы разобраться.

[Хакер]

Читай третий, пятый, сотый раз, пока прозрение не настанет, значит.

Код кривой, потому что использует Local-функции (это мелочь) и (это главное) потому что напрочь убивает юникод второй перекодировкой. Причём, не случайно убивает, а целенаправленно, умышленно, вызывая WC2MB.

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

Почитать основы можно (нужно) в MSDN.

[arthur2]

Этот код кривой прежде всего потому, что от него бейсик время от времени падает. Всякие локалэлоки здесь нафиг не нужны, и вполне можно обойтись обычными строками:
viewtopic.php?p=6690695#p6690695)

Поскольку в бейсике строки как раз уникодные, достаточно этого:

Код: Выделить всё

Public Function UTF8ToUnicod(ByVal inString As String) As String
        Dim iStrSize    As Long
        Dim s           As String
'        inString = inString & vbNullChar '& vbNullChar
        iStrSize = Len(inString)
        s = String$(iStrSize, 0&)

        iStrSize = MultiByteToWideChar(idUTF8, 0&, inString, &HFFFF, StrPtr(s), iStrSize)

UTF8ToUnicod = Left$(s, iStrSize - 1)
End Function



[Хакер]

Ну это не совсем хорошо.

[arthur2]

Всё же лучше, чем было
А чем нехорошо?

[Хакер]

Лучше, не спорю.

Нехорошо по следующим причинам:

• Входная строка ByVal. Это значит, что создаётся копия входных данных ради одной лишь MB2WC-конвертации. Совершенно нет нужды выделять в строковой OLE-куче место и копировать данные для ещё одной копии входных данных. Это вопрос стиля и производительности.
• Входные данные As String, хотя там непонятно-что. Непонятно (не из типа, не из названия аргумента), в каком виде должна быть входная строка: как UTF-8 разнесённый по BSTR, или как UTF-8 наложенный на BSTR. Использовать String-переменные для хранения не UCS-2-строк — дурной тон. Это вопрос стиля. Указатель на байтовый массив был бы гораздо более правильным решением, но родных указателей нет, так что спорно это.
• Выделение «буфера» с помощью String, частиное копирование в него, а потом выделение из него строки с помощью Left: если из этого выделить только необходимые действия, то останется HeapAlloc, SysAllocStringLen и SysFreeString. Быстрее и стилистически правильнее.
• Если MB2WC сфейлит, то будет попытка взять Left-ом подстроку отрицательной длины, что приведёт к печальным последствиям (Invalid procedure call or agrument, наверняка).
• Ошибка в названии функции. И грамматическая (Unicod→Unicode) и смысловая (Unicode Transformation Format To Unicode — преобразование сливочного масла в масло)

[arthur2]

Забавно, но ByVal я добавил на всякий случай, чтобы не попортить входную строку. Изначально я добавлял к ней два нуля - но, вроде, работает и без этого

как UTF-8 разнесённый по BSTR, или как UTF-8 наложенный на BSTR. Использовать String-переменные для хранения не UCS-2-строк — дурной тон. Это вопрос стиля.

Ну, со стилем у меня всегда было не ахти А бейсик и сам хранит неуникодные строки как уникодные и постоянно конвертирует взад-вперед, так что вносить дополнительную путаницу я бы не стал.

если из этого выделить только необходимые действия, то останется HeapAlloc, SysAllocStringLen и SysFreeString. Быстрее и стилистически правильнее.

Ну, тогда вообще везде можно отказаться от бейсиковских средств работы со строками В принципе, так, наверное, и лучше и быстрее, но со строками всё же и понятней, и привычней.

Если MB2WC сфейлит

Что такое сфейлит?

В общем, получилось так:

Код: Выделить всё

Public Function UTF8(inString As String) As String
        Dim iStrSize    As Long
        Dim s           As String
       
        iStrSize = Len(inString)
        s = String$(iStrSize, 0&)

        If iStrSize Then iStrSize = MultiByteToWideChar(idUTF8, 0&, inString, &HFFFF, StrPtr(s), iStrSize)
        If iStrSize >= 0 Then
            UTF8 = Left$(s, iStrSize - 1)
        else
'тут, наверное, тоже что-то надо сделать?
        end if
End Function


[Diamock]

Уважаемый Arthur2, очень хочется, понять принцип преобразования UTF-8 в win-кодировку. Не могли бы вы прокомментировать свой код.
В частности строку:

Код: Выделить всё

iStrSize = MultiByteToWideChar(idUTF8, 0&, inString, &HFFFF, StrPtr(s), iStrSize)

Почему в аргументах API функции MultiByteToWideChar, стоят именно те значения, которые вы туда вписали.
P.s.
Вот ещё один код, рабочий. Хочется знать, насколько он кривой?

Код: Выделить всё

Public Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Public Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Public Const CP_UTF8 = 65001
'Purpose:Convert Utf8 to Unicode
Public Function UTF8_Decode(ByVal sUTF8 As String) As String
   Dim lngUtf8Size      As Long
   Dim strBuffer        As String
   Dim lngBufferSize    As Long
   Dim lngResult        As Long
   Dim bytUtf8()        As Byte
   Dim n                As Long

   If LenB(sUTF8) = 0 Then Exit Function
   If m_bIsNt Then
      On Error GoTo EndFunction
      bytUtf8 = StrConv(sUTF8, vbFromUnicode)
      lngUtf8Size = UBound(bytUtf8) + 1
      On Error GoTo 0
      'Set buffer for longest possible string i.e. each byte is
      'ANSI, thus 1 unicode(2 bytes)for every utf-8 character.
      lngBufferSize = lngUtf8Size * 2
      strBuffer = String$(lngBufferSize, vbNullChar)
      'Translate using code page 65001(UTF-8)
      lngResult = MultiByteToWideChar(CP_UTF8, 0, bytUtf8(0), _
         lngUtf8Size, StrPtr(strBuffer), lngBufferSize)
      'Trim result to actual length
      If lngResult Then
         UTF8_Decode = Left$(strBuffer, lngResult)
      End If
   Else
      Dim i                As Long
      Dim TopIndex         As Long
      Dim TwoBytes(1)      As Byte
      Dim ThreeBytes(2)    As Byte
      Dim AByte            As Byte
      Dim TStr             As String
      Dim BArray()         As Byte
      'Resume on error in case someone inputs text with accents
      'that should have been encoded as UTF-8
      On Error Resume Next
      TopIndex = Len(sUTF8)  ' Number of bytes equal TopIndex+1
      If TopIndex = 0 Then Exit Function ' get out if there's nothing to convert
      BArray = StrConv(sUTF8, vbFromUnicode)
      i = 0 ' Initialise pointer
      TopIndex = TopIndex - 1
      ' Iterate through the Byte Array
      Do While i <= TopIndex
         AByte = BArray(i)
         If AByte < &H80 Then
            ' Normal ANSI character - use it as is
            TStr = TStr & Chr$(AByte): i = i + 1 ' Increment byte array index
         ElseIf AByte >= &HE0 Then         'was = &HE1 Then
            ' Start of 3 byte UTF-8 group for a character
            ' Copy 3 byte to ThreeBytes
            ThreeBytes(0) = BArray(i): i = i + 1
            ThreeBytes(1) = BArray(i): i = i + 1
            ThreeBytes(2) = BArray(i): i = i + 1
            ' Convert Byte array to UTF-16 then Unicode
            TStr = TStr & ChrW$((ThreeBytes(0) And &HF) * &H1000 + (ThreeBytes(1) And &H3F) * &H40 + (ThreeBytes(2) And &H3F))
         ElseIf (AByte >= &HC2) And (AByte <= &HDB) Then
            ' Start of 2 byte UTF-8 group for a character
            TwoBytes(0) = BArray(i): i = i + 1
            TwoBytes(1) = BArray(i): i = i + 1
            ' Convert Byte array to UTF-16 then Unicode
            TStr = TStr & ChrW$((TwoBytes(0) And &H1F) * &H40 + (TwoBytes(1) And &H3F))
         Else
            ' Normal ANSI character - use it as is
            TStr = TStr & Chr$(AByte): i = i + 1 ' Increment byte array index
         End If
      Loop
      UTF8_Decode = TStr    ' Return the resultant string
      Erase BArray
   End If
EndFunction:

End Function

'Purpose:Convert Unicode string to UTF-8.
Public Function UTF8_Encode(ByVal strUnicode As String, Optional ByVal bHTML As Boolean = True) As String
   Dim i                As Long
   Dim TLen             As Long
   Dim lPtr             As Long
   Dim UTF16            As Long
   Dim UTF8_EncodeLong  As String

   TLen = Len(strUnicode)
   If TLen = 0 Then Exit Function
   If m_bIsNt Then
      Dim lngBufferSize    As Long
      Dim lngResult        As Long
      Dim bytUtf8()        As Byte
      'Set buffer for longest possible string.
      lngBufferSize = TLen * 3 + 1
      ReDim bytUtf8(lngBufferSize - 1)
      'Translate using code page 65001(UTF-8).
      lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), _
         TLen, bytUtf8(0), lngBufferSize, vbNullString, 0)
      'Trim result to actual length.
      If lngResult Then
         lngResult = lngResult - 1
         ReDim Preserve bytUtf8(lngResult)
         'CopyMemory StrPtr(UTF8_Encode), bytUtf8(0&), lngResult
         UTF8_Encode = StrConv(bytUtf8, vbUnicode)
         ' For i = 0 To lngResult
         '    UTF8_Encode = UTF8_Encode & Chr$(bytUtf8(i))
         ' Next
      End If
   Else
      For i = 1 To TLen
         ' Get UTF-16 value of Unicode character
         lPtr = StrPtr(strUnicode) + ((i - 1) * 2)
         CopyMemory UTF16, ByVal lPtr, 2
         'Convert to UTF-8
         If UTF16 < &H80 Then                                      ' 1 UTF-8 byte
            UTF8_EncodeLong = Chr$(UTF16)
         ElseIf UTF16 < &H800 Then                                 ' 2 UTF-8 bytes
            UTF8_EncodeLong = Chr$(&H80 + (UTF16 And &H3F))              ' Least Significant 6 bits
            UTF16 = UTF16 \ &H40                                   ' Shift right 6 bits
            UTF8_EncodeLong = Chr$(&HC0 + (UTF16 And &H1F)) & UTF8_EncodeLong  ' Use 5 remaining bits
         Else                                                      ' 3 UTF-8 bytes
            UTF8_EncodeLong = Chr$(&H80 + (UTF16 And &H3F))              ' Least Significant 6 bits
            UTF16 = UTF16 \ &H40                                   ' Shift right 6 bits
            UTF8_EncodeLong = Chr$(&H80 + (UTF16 And &H3F)) & UTF8_EncodeLong  ' Use next 6 bits
            UTF16 = UTF16 \ &H40                                   ' Shift right 6 bits
            UTF8_EncodeLong = Chr$(&HE0 + (UTF16 And &HF)) & UTF8_EncodeLong   ' Use 4 remaining bits
         End If
         UTF8_Encode = UTF8_Encode & UTF8_EncodeLong
      Next
   End If
   'Substitute vbCrLf with HTML line breaks if requested.
   If bHTML Then
      UTF8_Encode = Replace$(UTF8_Encode, vbCrLf, "")
   End If
End Function

Пробовал использовать его, VB ошибок не выдаёт.

[arthur2]

Diamock Вот описание (думаю, довольно кривое, но мне оно помогло
http://soobcha-vb.narod.ru/projects/act ... depage.htm


Вкратце:
idUTF8 - константа As Long = 65001, определяющая, из какой кодировки преобразовываем.

Второй параметр - флаги того, как обрабатывать символы, которые не получилось преобразовать. Передаю просто 0

Третий параметр - исходная строка

Четвертый - длина этой строки (если &hffff, значит длина высчитывается автоматически по двум нулям в конце. Кстати, здесь, пожалуй, косяк - надо бы передавать просто -1)

Дальше - буфер, в который будет записан результат

Длинна этого буфера

Символ по умолчанию на случай, если символ не может быть преобразован

Флаг, показывающий, был ли использован символ по умолчанию.

Функция возвращает длину строки-результата.

в win-кодировку

такой кодировки не бывает Есть конкретные кодировки, например, Windows 1251.

[Andrey Fedorov]

Вот ещё один код, рабочий. Хочется знать, насколько он кривой?

Зачем для поставленной задачи вообще API как таковое?

Получаем страничку по HTMLDocument.createDocumentFromUrl...

И разбираем ее используя MSHTML, примерно так:

Код: Выделить всё

                For Each HTMLTable1 In HTMLDocument1.All.tags("TABLE")
                    If HTMLTable1.className = "result_table" Then
                        Set HTMLTableRow1 = HTMLTable1.rows(1)
                        If Not HTMLTableRow1 Is Nothing Then
                            If HTMLTableRow1.className = "result_table_datarow_border" Then



[Хакер]

Забавно, но ByVal я добавил на всякий случай, чтобы не попортить входную строку. Изначально я добавлял к ней два нуля - но, вроде, работает и без этого

Ничего не будет с входным буфером. Надо читать документацию. В документвации этот параметр MB2WC имеет тип LPCSTR. Знаешь что это значит? LP — Long Pointer, C — Constant, STR — String. Видишь буковку С? Это очень хорошая буковка

Ну, со стилем у меня всегда было не ахти А бейсик и сам хранит неуникодные строки как уникодные и постоянно конвертирует взад-вперед, так что вносить дополнительную путаницу я бы не стал.

Как раз путаницу ты и внём. У VB6 всё логично и предсказуемо: строки везде в UCS-2, за границу COM-мира уходят/приходят как ANSI.

У тебя логики никакой. Если бы я не видел внутренностей функции, мог бы до задымление мозгов пытаться логически догадаться, в каком виде должно поступить строка в твою функцию. Так и не догадался бы, потому что невозможно.

Ну, тогда вообще везде можно отказаться от бейсиковских средств работы со строками В принципе, так, наверное, и лучше и быстрее, но со строками всё же и понятней, и привычней.

Всегда есть точка равновесия. То, что я сказал, не на столько непонятнее, чтобы отказываться. OLEAPI, кроме того, гораздо ближе к VBAPI, чем WInAPI, которого как огня боятся неразумные.

Что такое сфейлит?

Потерпит неудачу.

[arthur2]

То, что я сказал, не на столько непонятнее, чтобы отказываться.

Это очень субъективно. Тебе может и понятно, а начинающим - точно понятней с привычными бейсиковскими строками.

Насчёт байтового массива вместо входной строки - может так и лучше (и не будет лишних конвертаций). Только по степени понятности, по-моему, эти варианты не отличаются. Может, просто дать более информативное имя для параметра?

[Kytx]

Несколько дней гуглинга и куча различных неудачных попыток заставила обратиться к форуму.

Задача следующая:
Есть сотни однотипных html файлов предварительно скачанных на винт с помощью URLDownloadToFile.
Структура файлов однотипная:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
<title>Заголовок</title>
</head>
<body>
...
<table>

<tr><td>Параментр 1</td><td>Значение 1</td></tr>
<tr><td>Параментр 2</td><td>Значение 2</td></tr>
<tr><td>Параментр 3</td><td>Значение 3</td></tr>
....
<tr><td>Параментр N</td><td>Значение N</td></tr>
....
</table>
....
</body>

Помогите написать код получения данных из таблицы данных файлов.
Насколько понимаю HTML можно парсить как и XML. С последним проделываю это регулярно, а с ХТМЛ не получается.

[alibek]

Насколько понимаю HTML можно парсить как и XML. С последним проделываю это регулярно, а с ХТМЛ не получается.

Неправильно понимаешь.
Подобным образом можно работать с XHTML, а не с HTML.
Используй объектную модель (DOM), работая с ней через библиотеку MSHTML.

[Kytx]

Sub Primer()
Dim HTMLDoc As MSHTML.HTMLDocument

Set HTMLDoc = New HTMLDocument
HTMLDoc.Open "d:\509026.html"

End Sub

Дошел максимум до этого. При дебаге в "HTMLDoc = [object]".
Как разложить его на элементы? Или хотя бы получить первую таблицу из файла?

з.ы. Перепробовал кучу вариантов, но все безуспешно

[alibek]

Попробуй так:

Код: Выделить всё

Set dom = CreateObject("HTMLFile")
dom.write <data>


[Kytx]

Спасибо to alibek. Процесс пошел . Теперь после выполнения процедуры в переменной x будет содержимое body файла.
Но возникло два вопроса:
1. Какого типа объект Doc? Насколько понял это не MSHTML.HTMLDocument
Если убрать апостроф перед As MSHTML.HTMLDocument, то возникает ошибка в строке с "Doc.Write FileText".

2. В ходе "Doc.Write FileText" вылетает две одинаковых ошибки:

Во время выполнения произошла ошибка.
Запустить отладку?

Строка 1.
Ошибка: Синтаксическая ошибка.

При этом на обработчик ошибок "On Error Resume next" не реагирует. Как от них можно избавиться?

Код: Выделить всё

Sub Primer()

    Dim nFreeFile As Integer, FilePath As String, FileText As String
    FilePath = "d:\509026.html"
   
    ' Считываем тело файла
    nFreeFile = FreeFile
    Open FilePath For Input As nFreeFile
    FileText = input(FileLen(FilePath), #nFreeFile)
    Close nFreeFile
   
    ' Создаем объект Doc.
    Dim Doc                  'As MSHTML.HTMLDocument
    Set Doc = CreateObject("HTMLFile")
   
    'Открываем документ и пишем в него тело файла
    Doc.Open
    Doc.Write FileText
    Doc.Close
   
    x = Doc.body.innerHTML

End Sub

[alibek]

Код: Выделить всё

Dim fn As Integer, dom As Object
fn = FreeFile
Open "..." For Input As #fn
Set dom = CreateObject("HTMLFile")
dom.write Input(LOF(fn), #fn)
Close #fn
MsgBox dom.document.innerHTML


Как-то так.
В принципе, можно использовать dom.load или что-то похожее, чтобы сразу файл загрузить, но не помню точно имя метода.