VBA - 从网页创建表 - 几乎就在那里

Question

希望一切都好！我检查了其他帖子，但我无法提取 MP3 URL（我可以在调试打印中看到它们）。我知道它们以“.href”结尾，但是我切片宏甚至不会完成..

请注意，我已启用 Microsoft XML v6.0 和 HTML 对象库

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

--

任何帮助将不胜感激。 感谢您的宝贵时间！

Answer 1

您想解决tbl，正确放置行和列的增量，最后，有很多方法可以确定何时访问href，在这种情况下，最好的IMO是使用测试td 的类名，因为 tds 和子 a 标记具有相同的类名。

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