Helpex - Trao đổi & giúp đỡ Đăng nhập
3

Tôi muốn lấy một số dữ liệu từ trang web http://www.eex.com/en/market-data/power/deri Phái sinh-market/phelix-futures .

Nếu tôi đang sử dụng đối tượng InternetExplorer cũ (mã bên dưới), tôi có thể xem qua tài liệu HTML. Nhưng tôi muốn sử dụng XMLHTTPđối tượng (mã thứ hai).

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

Sử dụng mã với đối tượng 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 

Tôi chỉ nhận được HTML cơ bản:

<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>

Tôi muốn xem qua các bảng và dữ liệu tương ứng ... Và cuối cùng tôi muốn chọn khoảng thời gian khác nhau từ Năm đến Tháng:

Tôi thực sự đánh giá cao bất kỳ sự giúp đỡ nào! Cảm ơn bạn!

3 hữu ích 4 bình luận 21k xem chia sẻ
5

Tôi có thể xác nhận rằng tôi nhận được HTML giống như bạn khi tôi chạy mã của bạn (có hoặc không có thẻ url). Tôi tìm thấy một bài viết hữu ích ở đây . Tôi đã sửa đổi mã của bạn bằng phương pháp được tìm thấy ở đó và bây giờ có vẻ như nó đã tải xuống thông tin chính xác.

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

Tôi đã bao gồm phụ gọi vì các thẻ url dường như gây ra lỗi cho yêu cầu 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

Chỉnh sửa nhận xét sau:

Tôi không thể tìm thấy các phần tử bảng bằng đối tượng MSXML2, mã nguồn dường như không chứa chúng. Trong firebug, các thẻ td hiện diện nên tôi kiểm tra rằng bảng được tạo bởi mã JavaScript. Tôi không biết liệu MSXML2 có thể chạy JavaScript hay không vì vậy tôi đã sửa đổi phụ để sử dụng internet explorer, nó không phải là mã nhanh, nhưng nó tìm thấy các phần tử td và cho phép nhấp vào các tab. Tôi nhận thấy rằng các phần tử td có thể mất một thời gian để có sẵn (có lẽ đối với IE phải chạy JavaScript) vì vậy tôi đã thực hiện một vài bước trong đó xl đợi trước khi tải xuống dữ liệu.

Tôi đã đặt một số mã sẽ tải xuống nội dung của các phần tử td vào trang tính đang hoạt động, hãy cẩn thận nếu chạy nó trong sổ làm việc có dữ liệu hữu ích trong đó.

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
5 hữu ích 3 bình luận chia sẻ
loading
Không tìm thấy câu trả lời bạn tìm kiếm? Duyệt qua các câu hỏi được gắn thẻ html vba excel web-scraping , hoặc hỏi câu hỏi của bạn.

Có thể bạn quan tâm

loading