Public Sub Price_Parser()
Dim LinkCell As Range
Dim sURI As String
Dim oHttp As Object
Dim htmlcode, outstr As String
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
For Each LinkCell In Selection
sURI = LinkCell.Hyperlinks(1).Address
oHttp.Open "GET", sURI, False
oHttp.Send
'получаем HTML страницы
htmlcode = oHttp.responseText
a = Len(htmlcode)
b = InStr(1, htmlcode, LinkCell.Value, vbTextCompare)
htmlcode = Right(htmlcode, a - b + 1)
htmlcode = Mid(htmlcode, InStr(1, htmlcode, "floatr" + 8, 10)
LinkCell.Offset(0, 1).NumberFormat = "0.00"
LinkCell.Offset(0, 1).Value = htmlcode
Next LinkCell
Set oHttp = Nothing
MsgBox ("ГОТОВО"
End Sub
работает нормально со всеми протестированными сайтами, кроме одного. В случае если адрес гиперссылки имеет такой вид http://www.technomarin.ru/index.phtml?center=20&prod_id=4497#begpage то макрос вываливается с ошибкой. В случае если запускать непосредственно из Экселя, то ошибка "Out of memory", а при попытке построчного запуска через F8, вылетает с ошибкой "Run-time error '-1072896658 (c00ce56e)': Automation error" Ошибка всегда проявляется при выполнении этой строчки в коде:
в чем проблема мне не понятно, но вот так все работает:
Скрытый текст
Код
Sub dd()
Dim strHtml$
Dim IE As Object, IEdoc As Object
On Error GoTo errHandler
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate Selection.Text
While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend
Set IEdoc = IE.document: DoEvents: DoEvents
strHtml = IEdoc.body.outerHTML
Debug.Print strHtml
GoTo exit_
errHandler:
If Err.Number <> 0 Then MsgBox "При загрузке данных с сайта '" & URL_main & "' произошла ошибка!", vbCritical + vbOKOnly, "Сбой в программе"
exit_:
On Error Resume Next: IE.Quit
End Sub
Вам не повезло с этим сайтом,он возвращает байты. Так работает.
Код
sURI = LinkCell.Hyperlinks(1).Address
oHttp.Open "GET", sURI, False
oHttp.Send
'получаем HTML страницы
htmlcode =""
sBody = oHttp.responseBody
For i = 0 To UBound(sBody)
htmlcode = htmlcode & ChrW(AscW(Chr(AscB(MidB(sBody, i + 1, 1)))))
Next
a = Len(htmlcode)