如何在 html 中使用带有 VBA 条件的 queryselectorall 获取标签？

Question

片段：

<table>
<tbody>
<tr>
<td valign="top" align="left">
<nobr>FILENAME</nobr>
</td>
<td valign="center" align="left">
<b>
<font size="2px">
<nobr>FILENUMBER0311</nobr>
</font>
</b>
<font size="2px">&nbsp;</font>
</td>
<td valign="top" align="right"></td>
<tr>
<td valign="top" align="left">Date</td>
<td colspan="2" valign="center" align="left">
<font color="#C00000">
<b>
CANCELED
</b>
</tr>

…

<tr>
<td valign="top" align="left">
<nobr>FILENAME</nobr>
</td>
<td valign="center" align="left">
<b>
<font size="2px">
<nobr>FILENUMBER0345</nobr>
</font>
</b>
<font size="2px">&nbsp;</font>
</td>
<td valign="top" align="right"></td>
<tr>
<td valign="top" align="left">Date</td>
<td colspan="2" valign="center" align="left">
<font color="#C00000">
<b>
CONFIRMED
</b>
</tr>

website-html 有一个带有多个 tr 标记的表格。在每个 tr-tag 中，要么在 b-tags 之间有 CONFIRMED 条目，要么有 CANCELED 条目。在 CONFIRMED 的情况下，我需要一个返回 FILENUMBERxxxx 值的代码。在这种情况下，我不知道如何将“选择器”、“instr”和其他可能的操作结合起来。

我的代码：（什么都没有发生！）。有谁知道解决方案？谢了

    Sub GetData()
    
Const url = "https://www.zvg-portal.de/index.php?button=Suchen&all=1"
    Dim Html As MSHTML.HTMLDocument
    Dim xhr As Object, elm As Object
    Dim I As Long
            
    Set Html = New MSHTML.HTMLDocument
    Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
        
    With xhr
        .Open "POST", url, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "ger_name=--" & " " & "Alle" & " " & "Amtsgerichte" & " " & "--&" & "order_by=2&land_abk=ni&ger_id=0"
         Html.body.innerHTML = .responseText
    End With

With Html.querySelectorAll("tr")
Set elm = Html.querySelectorAll("tr")
    For I = 0 To 500
    'right now I do not know how to set the number of repeats, therefore 0 to 500
        If InStr(elm.Item(I).innerText, "Termin") > 0 Then
            ActiveSheet.Cells(I + 2, 3) = elm.Item(I).ParentNode.PreviousSibling.FirstChild.NextSibling.innerText
            'need the numeric value of Aktenzeichen
            Exit For
        End If
    Next I

End With
        
    End Sub

Answer 1

以下处理行，当它看到一个列表分隔符（tr，只有 1 个子 td）时，它会增加输出数组的行计数器。

它对aufgehoben 使用Instr 测试来确定带有termin 的行是否表示取消，并在输出数组中返回真/假值。

在循环过程中，Aktenzeichen 值被提取；这写在输出数组的第一列中，在 True/False for cancelled 之前。

---

Option Explicit

Public Sub GetData()
    Const url = "https://www.zvg-portal.de/index.php?button=Suchen&all=1"
    Dim html As MSHTML.HTMLDocument, xhr As Object
     
    Set html = New MSHTML.HTMLDocument
    Set xhr = CreateObject("MSXML2.XMLHTTP")
        
    With xhr
        .Open "POST", url, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "ger_name=--" & " " & "Alle" & " " & "Amtsgerichte" & " " & "--&" & "order_by=2&land_abk=ni&ger_id=0"
        html.body.innerHTML = .responseText
    End With
    
    Dim table As MSHTML.HTMLTable
    
    Set table = html.querySelector("table[border='0']")
    
    Dim row As MSHTML.HTMLTableRow, newBlock As Boolean
    Dim r As Long, cancellations(), aktenzeichen As String
    
    ReDim cancellations(1 To 1000, 1 To 2)
    
    r = 1
    
    For Each row In table.Rows
        
        If newBlock Then r = r + 1
        
        If InStr(1, row.innerHTML, "Aktenzeichen", vbTextCompare) > 0 Then
            aktenzeichen = Replace$(row.Children(1).getElementsByTagName("nobr")(0).innerText, " (Detailansicht)", vbNullString)
            cancellations(r, 1) = aktenzeichen
        End If
        
        If Trim$(row.Children(0).innerText) = "Termin" Then
            cancellations(r, 2) = (InStr(1, row.Children(1).innerText, "aufgehoben", vbTextCompare) > 0)
        End If

        newBlock = (row.Children.Length = 1)
        
    Next
    
    cancellations = Application.Transpose(cancellations)
    
    Dim headers()
    
    headers = Array(" Aktenzeichen", "Cancelled")
    ReDim Preserve cancellations(1 To UBound(headers) + 1, 1 To r)
    
    cancellations = Application.Transpose(cancellations)
    
    With ActiveSheet
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(cancellations, 1), UBound(cancellations, 2)) = cancellations
    End With

End Sub