Convert HTML-table to Excel using VBA

后端 未结 9 2094
难免孤独
难免孤独 2021-02-05 02:51

Convert HTML-table to Excel

The code below fetches the HTML-table at https://rasmusrhl.github.io/stuff, and converts it to Excel-format.

The pr

9条回答
  •  一整个雨季
    2021-02-05 02:56

    You may give this a try to see if you get the desired output...

    Sub GetWebData()
    Dim IE As Object
    Dim doc As Object
    Dim TRs As Object
    Dim TR As Object
    Dim Cell As Object
    Dim r As Long, c As Long
    
    Application.ScreenUpdating = False
    
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False
    IE.navigate "https://rasmusrhl.github.io/stuff/"
    Do While IE.Busy Or IE.readyState <> 4
        DoEvents
    Loop
    Set doc = IE.document
    
    Set TRs = doc.getElementsByTagName("tr")
    Cells.Clear
    
    For Each TR In TRs
        r = r + 1
        For Each Cell In TR.Children
            c = c + 1
            Cells(r, c).NumberFormat = "@"
            Cells(r, c) = Cell.innerText
        Next Cell
        c = 0
    Next TR
    IE.Quit
    Columns.AutoFit
    Application.ScreenUpdating = True
    End Sub
    

    Solution 2:

    To make it work, you need to add the following two references by going to Tools (on VBA Editor) --> References and then find the below mentioned two references and check the checkboxes for them and click OK.

    1) Microsoft XML, v6.0 (find the max version available)

    2) Microsoft HTML Object Library

    Sub GetWebData2()
    Dim XMLpage As New MSXML2.XMLHTTP60
    Dim doc As New MSHTML.HTMLDocument
    Dim TRs As IHTMLElementCollection
    Dim TR As IHTMLElement
    Dim Cell As IHTMLElement
    Dim r As Long, c As Long
    
    Application.ScreenUpdating = False
    
    Set XMLpage = CreateObject("MSXML2.XMLHTTP")
    
    XMLpage.Open "GET", "https://rasmusrhl.github.io/stuff/", False
    XMLpage.send
    doc.body.innerhtml = XMLpage.responsetext
    Set TRs = doc.getElementsByTagName("tr")
    Set TRs = doc.getElementsByTagName("tr")
    Cells.Clear
    
    For Each TR In TRs
        r = r + 1
        For Each Cell In TR.Children
            c = c + 1
            Cells(r, c).NumberFormat = "@"
            Cells(r, c) = Cell.innerText
        Next Cell
        c = 0
    Next TR
    Columns.AutoFit
    Application.ScreenUpdating = True
    End Sub
    

提交回复
热议问题