Не распознается текст полученный с html

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Не распознается текст полученный с html (Макросы/Sub)

legas

Дата: Вторник, 24.02.2015, 16:35 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Доброго дня.

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

Run-time error '-1072896658 (c00ce56e)':

System Error: -1072896658.

и подкрашивать строчку: htmlcode = oHttp.responseText

Насколько я понимаю какая-то проблема в кодировке. Но что с этим делать я не знаю.
Буду благодарен за любую подсказку.

[vba]

Код

Dim sURI As String
Dim oHttp As Object
Dim htmlcode, outstr, prom As String
Dim i, d, m, y As Integer

On Error Resume Next
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
End If

On Error GoTo 0
If oHttp Is Nothing Then
Exit Sub
End If

i = 1

While Sheets(1).Cells(i, 1) > ""
sURI = "http://rkn.gov.ru//communication/licensing-activity/assignment/?inn=7713076301&outNum=" & Mid(Sheets(1).Cells(i, 1), 1, (InStr(1, Sheets(1).Cells(i, 1), " ")))

oHttp.Open "POST", sURI, False
oHttp.Send
htmlcode = oHttp.responseText

outstr = Mid(htmlcode, InStr(1, htmlcode, "<tr class='clmn1' >") + 19, 80)
prom = outstr ' äëÿ äàòû
outstr = Mid(htmlcode, InStr(1, htmlcode, "<td class=""t1"">") + 15, 10)

prom = Mid(prom, InStr(1, prom, "<td>") + 4, 10)

outstr = Replace(outstr, "</td>", "")
outstr = Replace(outstr, "</td", "")
outstr = Replace(outstr, "</t", "")
outstr = Replace(outstr, "</", "")
outstr = Replace(outstr, "<", "")

Sheets(1).Cells(i, 3) = prom

i = i + 1
Wend

Set oHttp = Nothing

End Sub

[/vba]

Сообщение отредактировал legas - Среда, 25.02.2015, 09:57

Ответить

alex77755

Дата: Вторник, 24.02.2015, 19:20 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 362

Репутация: 64 ±

Замечаний: 0% ±

И что там в ячейке?
Cells(i, 1), 1, (InStr(1, Sheets(1).Cells(i, 1), " ")

Могу помочь в VB6, VBA
Alex77755@mail.ru

Ответить

legas

Дата: Среда, 25.02.2015, 10:05 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

В столбце Cells(i, 1) значения, которые вводятся в определенное поле на сайте, далее выполняется запрос на сайт и в столбец Cells(i, 2) возвращаются значения результата запроса.

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

Приложил пример

К сообщению приложен файл: 9523887.xls (39.5 Kb)

Ответить

doober

Дата: Среда, 25.02.2015, 12:07 | Сообщение № 4

Группа: Друзья

Ранг: Ветеран

Сообщений: 947

Репутация: 323 ±

Замечаний: 0% ±

Excel 2010

Цитата legas, 25.02.2015 в 10:05, в сообщении № 3

что возвращаемые данные не распознаются, хотя может и не в этом

И не только в этом
Внес изменения.
[vba]

Код

      sURI = "http://rkn.gov.ru//communication/licensing-activity/assignment/?inn=7713076301&outNum=" & Mid(Sheets(1).Cells(i, 1), 1, (InStr(1, Sheets(1).Cells(i, 1), " ")))
         oHttp.Open "POST", sURI, False
         oHttp.setRequestHeader "Accept-Encoding", "gzip,deflate"
         oHttp.Send

         sHTMLBody = oHttp.responseBody
         htmlcode = ""
         For i = 0 To UBound(sHTMLBody)
             htmlcode = htmlcode & ChrW(AscW(Chr(AscB(MidB(sHTMLBody, i + 1, 1)))))
         Next
t

[/vba]

Сообщение отредактировал doober - Среда, 25.02.2015, 12:17

Ответить

legas

Дата: Среда, 25.02.2015, 12:41 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Все заработало. Отлично. Большое спасибо.

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Не распознается текст полученный с html (Макросы/Sub)

Страница 1 из 1
1