VBA-从TR子列表中获取HREF

Question

我正在尝试从该站点上的表格中提取所有单个单元格和数据：https://www.world-airport-codes.com/，特别是此处子页面上的行https://www.world-airport-codes.com/alphabetical/airport-code/a.html?page=1 通过循环浏览不同的页面和子页面。

问题是，虽然这对文本很有效，但我无法获得第一个单元格中包含的参考链接（我最终还需要遍历所有这些页面）。

页面元素的结构如下

块引用

<tbody>
<tr class="light-row">
<th>

                   <a> href="/french-polynesia/anaa-226.html">Anaa</a>

                        <td>
                            <span class="hide-for-large mini-header">Type: </span>
                            Medium airport                            </td>

                                                        <td style="padding: 0;"></td>
                        
                                                        <td><span class="hide-for-large mini-header">Country: </span>French Polynesia</td>
                        
                                                        <td><span class="hide-for-large mini-header">IATA: </span>AAA</td>
                        
                                                        <td><span class="hide-for-large mini-header">ICAO: </span>NTGA</td>

块引用

我的代码如下（这是为了剪掉所有的页面和子页面循环而简化的）

Sub ListVideosOnPage(VidCatName As String, VidCatURL As String)

Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim VidRow As MSHTML.IHTMLElement
Dim VidRows As MSHTML.IHTMLElementCollection


Dim TableSection As MSHTML.IHTMLElement
Dim TableRow As MSHTML.IHTMLElement
Dim TableCell As MSHTML.IHTMLElement
Dim VidLink As MSHTML.IHTMLElement
Dim TableLink As MSHTML.IHTMLElement


XMLReq.Open "Get", VidCatURL, False
XMLReq.send

If XMLReq.Status <> 200 Then
    MsgBox "Problem" & vbNewLine & XMLReq.Status & "-" & XMLReq.statusText
    Exit Sub
End If

HTMLDoc.body.innerHTML = XMLReq.responseText
Set XMLReq = Nothing

Set VidRows = HTMLDoc.getElementsByClassName("stack2")


For Each VidRow In VidRows
    'Set VidLink = VidRow.getElementsByTagName("a")(0)
    'Debug.Print VidLink.tagName, VidLink.innerText, VidLink.getAttribute("href")
    
    
    For Each TableRow In VidRow.Children
    'Set VidLink = TableRow.getElementsByTagName("a")(0)
    'Debug.Print TableRow.tagName, TableRow.innerText, TableRow.getAttribute("href")

        
        
       
        
        For Each TableCell In TableRow.Children
        'Set VidLink = TableCell.getElementsByTagName("a")(0)
        'Debug.Print TableCell.tagName, TableCell.innerText, TableCell.getAttribute("href")
        
            For Each TableLink In TableCell.Children
            Set VidLink = TableLink.getElementsByTagName("th")(0)
            Debug.Print TableLink.tagName, TableLink.innerText, TableLink.getAttribute("href")
        
        
           Next TableLink
        
        Next TableCell
        
        
     Next TableRow
    
    
Next VidRow

结束子

我在“for each”部分的注释掉的部分中留下了，只是为了表明我的想法。

我遇到的两个问题是，它要么为 href 返回 NULL（在本例中），要么，如果我将 debug.print 更改为 VidLink 而不是 TableLink 我得到一个 运行时错误 91 对象变量（我尝试过多种方式设置）。

我尝试过的其他一些事情包括将变量更改为集合并设置更多变量以专门循环遍历行，以及直接执行 .href 值引用。这不是一个类，所以我不知道为什么它没有获取属性。

我花了很多时间在这个圈子里转来转去，我真的迷失了这个话题。我最大的挫败感是我不明白我的想法有什么问题。

任何帮助将不胜感激。

Answer 1

我怀疑该网站不允许抓取。我注意到它表面上指纹你的要求。尽管我不同意这种做法，但将User-Agent 标头中传递的内容随机化就足够了。

然后，您需要在从第 2 行开始循环遍历表时，对当前标记是否为 TH 进行区分大小写的测试。如果是TH，那么你可以抓住子a标签，首先检查有一个，然后打印href属性。

只有一个表，所以您可以使用 querySelector 来获取它。此外，尽可能使用精确的输入。

Option Explicit

Public Sub ListVideosOnPage()
    Dim xmlReq As MSXML2.XMLHTTP60
    Dim htmlDoc As MSHTML.HTMLDocument
    
    Set xmlReq = New MSXML2.XMLHTTP60: Set htmlDoc = New MSHTML.HTMLDocument
    
    xmlReq.Open "Get", "https://www.world-airport-codes.com/alphabetical/airport-code/a.html?page=1", False
    xmlReq.setRequestHeader "User-Agent", CStr(Application.WorksheetFunction.RandBetween(0, 1000000000))
    xmlReq.send

    If xmlReq.Status <> 200 Then
        MsgBox "Problem" & vbNewLine & xmlReq.Status & "-" & xmlReq.statusText
        Exit Sub
    End If

    htmlDoc.body.innerHTML = xmlReq.responseText
    
    Dim vidTable As MSHTML.HTMLTable, vidRow As MSHTML.HTMLTableRow
    Dim vidCell As MSHTML.HTMLTableCell, i As Long

    Set vidTable = htmlDoc.querySelector(".stack2") 'Single table
    
    For i = 1 To vidTable.Rows.Length - 1        'loop rows of table
        Set vidRow = vidTable.Rows(i)
        
        For Each vidCell In vidRow.Children
            If vidCell.tagName = "TH" And vidCell.Children.Length > 0 Then Debug.Print vidCell.Children(0).href 'Test if header tag. Case sensitive.
            Debug.Print vidCell.innerText
        Next vidCell
        
    Next i
End Sub