VBA - Create Table from WebPage - almost there

user_15919601 0
Viewed 35

Hope all is well! I checked other posts but I just can't extract the MP3 URLs (I can see them in the debug print). I'm aware that they end in ".href" but however I slice macro won't even reach completion..

Please note I've enabled Microsoft XML v6.0 & HTML Object library

Sub FETCHER()

Dim xmlHttp As Object
Dim TR_col As Object, Tr As Object
Dim TD_col As Object, Td As Object
Dim row As Long, col As Long

    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    myURL = "https://www.zophar.net/music/nintendo-64-usf/1080-Snowboarding"

    xmlHttp.Open "GET", myURL, False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.send

    Dim html As Object
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = xmlHttp.responseText

    Dim tbl As Object
    Set tbl = html.getElementById("tracklist")

    row = 1
    col = 1

    Set TR_col = html.getElementsByTagName("TR")
    For Each Tr In TR_col
        Set TD_col = Tr.getElementsByTagName("TD")
        For Each Td In TD_col
            Cells(row, col) = Td.innerText
            '.href reference would go here-------
            col = col + 1
        Next
        col = 1
        row = row + 1
    Next

End Sub

--

Any help would greatly be appreciated. Thanks for your time!

web-scraping vba excel html
1 Answers

You want to work off tbl, correctly place your increments for row and col, and finally, there are numerous methods to determine when to access href, the best, IMO in this scenario, is to use a test of classname of the td as both tds with child a tags have the same classname.

Public Sub FETCHER()
    Dim xmlHttp As Object
    Dim TR_col As Object, Tr As Object
    Dim TD_col As Object, Td As Object
    Dim row As Long, col As Long

    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    myURL = "https://www.zophar.net/music/nintendo-64-usf/1080-Snowboarding"

    xmlHttp.Open "GET", myURL, False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.send

    Dim html As Object, tbl As Object
    
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = xmlHttp.responseText
    Set tbl = html.getElementById("tracklist")
    Set TR_col = tbl.getElementsByTagName("TR")
     
    row = 1
    
    For Each Tr In TR_col
        
        col = 1
        
        Set TD_col = Tr.getElementsByTagName("TD")
        
        For Each Td In TD_col

            If Td.className = "download" Then
                ActiveSheet.Cells(row, col) = Td.Children(0).href
            Else
                ActiveSheet.Cells(row, col) = Td.innerText
            End If
            
            col = col + 1
            
        Next
        
        row = row + 1
        
    Next

End Sub
user_62412350
Related