2014-02-07 3 views
2

Я хотел бы получить некоторые данные с веб-страницы http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures.web scraping with vba using XMLHTTP

Если я использую старый объект InternetExplorer (код ниже), я мог бы пройти через HTML-документ. Но я хотел бы использовать объект XMLHTTP (второй код).

Sub IEZagon() 
    'we define the essential variables 
    Dim ie As Object 
    Dim TDelement, TDelements 
    Dim AnhorLink, AnhorLinks 

    'add the "Microsoft Internet Controls" reference in your VBA Project indirectly 
    Set ie = CreateObject("InternetExplorer.Application") 
    With ie 
     .Visible = True 
     .navigate ("[URL]http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures[/URL]") 
     While ie.ReadyState <> 4 
      DoEvents 
     Wend 
     Set AnhorLinks = .document.getElementsbytagname("a") 
     Set TDelements = .document.getElementsbytagname("td") 
     For Each AnhorLink In AnhorLinks 
      Debug.Print AnhorLink.innertext 
     Next 
     For Each TDelement In TDelements 
      Debug.Print TDelement.innertext 
     Next 
    End With 
    Set ie = Nothing 
End Sub 

Использование кода объекта XMLHTTP:

Sub FuturesScrap(ByVal URL As String) 
    Dim XMLHttpRequest As XMLHTTP 
    Dim HTMLDoc As New HTMLDocument 

    Set XMLHttpRequest = New MSXML2.XMLHTTP 
    XMLHttpRequest.Open "GET", URL, False 
    XMLHttpRequest.send 
    While XMLHttpRequest.readyState <> 4 
     DoEvents 
    Wend 

    Debug.Print XMLHttpRequest.responseText 
    HTMLDoc.body.innerHTML = XMLHttpRequest.responseText 

    With HTMLDoc.body 
     Set AnchorLinks = .getElementsByTagName("a") 
     Set TDelements = .getElementsByTagName("td") 

     For Each AnchorLink In AnchorLinks 
      Debug.Print AnhorLink.innerText 
     Next 

     For Each TDelement In TDelements 
      Debug.Print TDelement.innerText 
     Next 
    End With 
End Sub 

Я получаю только основные HTML:

<html> 
<head> 
<title>Resource Not found</title> 
<link rel= 'stylesheet' type='text/css' href='/blueprint/css/errorpage.css'/> 
</head> 
<body> 
<table class="header"> 
<tr> 
<td class="CMTitle CMHFill"><span class="large">Resource Not found</span></td> 
</tr> 
</table> 
<div class="body"> 
<p style="font-weight:bold;">The requested resource does Not exist.</p> 
</div> 
<table class="footer"> 
<tr> 
<td class="CMHFill"> </td> 
</tr> 
</table> 
</body> 
</html> 

Я хотел бы ходить по таблицам и coresponding данных ... И, наконец, я хотел бы выбрать другой промежуток времени от года к месяцу:

I «Да, действительно признаю любую помощь! Спасибо!

+2

Похоже, вы запрашиваете неправильный URL ... –

+0

Я Colling право URL: – Figlio

+0

См ответ @ brettdj в [ЗДЕСЬ] (http://stackoverflow.com/questions/8798260/html- parsing-of-cricinfo-scorecards) –

ответ

3

Я могу подтвердить, что я получаю тот же HTML, что и вы, когда я запускаю ваш код (с или без тегов URL). Я нашел полезный пост here. Я изменил ваш код, используя найденный там метод, и теперь он загрузил правильную информацию.

Sub test() 
    Call FuturesScrap1("http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures") 
End Sub 

Я включил вызывающий элемент, потому что теги URL-адресов, по-видимому, вызывают ошибку для запроса MSXML.

Sub FuturesScrap1(ByVal URL As String) 
    Dim HTMLDoc As New HTMLDocument 
    Dim oHttp As MSXML2.XMLHTTP 
    Dim sHTML As String 
    Dim AnchorLinks As Object 
    Dim TDelements As Object 
    Dim TDelement As Object 
    Dim AnchorLink As Object 

    On Error Resume Next 
    Set oHttp = New MSXML2.XMLHTTP 
    If Err.Number <> 0 Then 
     Set oHttp = CreateObject("MSXML.XMLHTTPRequest") 
     MsgBox "Error 0 has occured while creating a MSXML.XMLHTTPRequest object" 
    End If 
    On Error GoTo 0 
    If oHttp Is Nothing Then 
     MsgBox "For some reason I wasn't able to make a MSXML2.XMLHTTP object" 
     Exit Sub 
    End If 

    'Open the URL in browser object 
    oHttp.Open "GET", URL, False 
    oHttp.send 
    sHTML = oHttp.responseText 

    Debug.Print oHttp.responseText 

    HTMLDoc.body.innerHTML = oHttp.responseText 

    With HTMLDoc.body 
     Set AnchorLinks = .getElementsByTagName("a") 
     Set TDelements = .getElementsByTagName("td") 

     For Each AnchorLink In AnchorLinks 
      Debug.Print AnchorLink.innerText 
     Next 

     For Each TDelement In TDelements 
      Debug.Print TDelement.innerText 
     Next 
    End With 

End Sub 

Редактировать folowing комментарий:

Я не смог найти элементы таблицы, используя MSXML2 объект, исходный код не появляется, чтобы содержать их. В firebug присутствуют теги td, поэтому я хочу, чтобы таблица была сгенерирована кодом JavaScript. Я не знаю, может ли MSXML2 запускать JavaScript, поэтому я модифицировал sub для использования Internet Explorer, это не быстрый код, но он находит элементы td и позволяет щелкнуть вкладки. Я обнаружил, что элементы td могут занять некоторое время, чтобы стать доступными (предположительно для IE необходимо запустить JavaScript), поэтому я поставил пару шагов, где xl ждет перед загрузкой данных.

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

Sub FuturesScrap3(ByVal URL As String) 

    Dim HTMLDoc As New HTMLDocument 
    Dim AnchorLinks As Object 
    Dim tdElements As Object 
    Dim tdElement As Object 
    Dim AnchorLink As Object 
    Dim lRow As Long 
    Dim oElement As Object 

    Dim oIE As InternetExplorer 

    Set oIE = New InternetExplorer 

    oIE.navigate URL 
    oIE.Visible = True 

    Do Until (oIE.readyState = 4 And Not oIE.Busy) 
     DoEvents 
    Loop 

    'Wait for Javascript to run 
    Application.Wait (Now + TimeValue("0:01:00")) 

    HTMLDoc.body.innerHTML = oIE.document.body.innerHTML 

    With HTMLDoc.body 
     Set AnchorLinks = .getElementsByTagName("a") 
     Set tdElements = .getElementsByTagName("td") ' 

     For Each AnchorLink In AnchorLinks 
      Debug.Print AnchorLink.innerText 
     Next AnchorLink 

    End With 

    lRow = 1 
    For Each tdElement In tdElements 
     Debug.Print tdElement.innerText 
     Cells(lRow, 1).Value = tdElement.innerText 
     lRow = lRow + 1 
    Next 

    'Clicking the Month tab 
    For Each oElement In oIE.document.all 
     If Trim(oElement.innerText) = "Month" Then 
      oElement.Focus 
      oElement.Click 
     End If 
    Next oElement 

    Do Until (oIE.readyState = 4 And Not oIE.Busy) 
     DoEvents 
    Loop 

    'Wait for Javascript to run 
    Application.Wait (Now + TimeValue("0:01:00")) 

    HTMLDoc.body.innerHTML = oIE.document.body.innerHTML 

    With HTMLDoc.body 
     Set AnchorLinks = .getElementsByTagName("a") 
     Set tdElements = .getElementsByTagName("td") ' 

     For Each AnchorLink In AnchorLinks 
      Debug.Print AnchorLink.innerText 
     Next AnchorLink 
    End With 

    lRow = 1 
    For Each tdElement In tdElements 
     Debug.Print tdElement.innerText 
     Cells(lRow, 2).Value = tdElement.innerText 
     lRow = lRow + 1 
    Next tdElement 

End sub 
+0

Я сделал такой же код последний суббота. Но у меня все еще проблема на этой веб-странице. С вашим и моим кодом я не могу перечислить 6 кнопок (якорей) с именем Year throught Day. Если я хочу пройти через разные таблицы на основе временного окна (год, квартал и т. Д.), Мне нужно щелкнуть по любой из этих кнопок. Но это не последняя проблема, в нашем коде мы не можем перечислить данные таблиц с кодом: [code] Для каждого TDelement В TDelements Debug.Print TDelement.innerText Next [\ code] – Figlio

+1

@Figlio Я изменил ответ, чтобы получить элементы TD и разрешить изменение таблицы, но использует межсетевой проводник, а не MSXML2, это может быть необходимо из-за JavaScript. –

+0

Спасибо. С IE работает. Я знаю, я сделал тот же код, что и ты. И у меня такая же проблема, что и метод Application.wait. Если это так и не идти с XMLHTTP, я останусь на IE. Еще раз спасибо! – Figlio