Как проверить html строку таблицы с помощью VBA?

Question

Моя строка VBA - это таблица HTML.

Let myTable = "<table><tr><th>LocationID</th><th>Lastname</th><th>Age</th>  </tr>  <tr>    <td>1234</td>    <td>Smith</td>    <td>50</td>  </tr>  <tr>    <td>1234</td>    <td>Jackson</td>    <td>94</td>  </tr><tr>    <td>1237</td>    <td>Doe</td>    <td>80</td>  </tr></table> 

Визуально выглядит так

LocationID   Lastname   Age
1234         Smith      50
1234         Jackson    94
1237         Doe        80

Мне нужно убедиться, что эта строка имеет одинаковые LocationID для каждой строки. Как я могу проанализировать эту строку и использовать VBA, чтобы утверждать, что первый столбец имеет те же значения? Есть ли встроенный парсер для html в VBA

Answer 1

Вы можете прочитать html из файла в MS HTML .HTMLDocument, используя ссылку на библиотеку объектов Microsoft HTML, а затем собрать список узлов всех строк. Предполагая, что в первой строке есть заголовки, затем l oop других строк и тестирование значения firstChild каждой строки.

Option Explicit

Public Sub test()
    Dim html As MSHTML.HTMLDocument, firstColumnSecondRow As String, rows As Object, i As Long

    Set html = GetHTMLFileContent("C:\Users\User\Desktop\test.html")
    Set rows = html.querySelectorAll("tr")

    Select Case rows.Length

    Case 1
        Debug.Print False
        Exit Sub
    Case 2
        Debug.Print True
    Case Is >= 3
        firstColumnSecondRow = rows.item(1).firstChild.innerText

        For i = 3 To rows.Length - 1
            If rows.item(i).firstChild.innerText <> firstColumnSecondRow Then
                Debug.Print False
                Exit Sub
            End If
        Next
        Debug.Print True
    End Select
End Sub

Public Function GetHTMLFileContent(ByVal filePath As String) As MSHTML.HTMLDocument
    '"C:\Users\User\Desktop\test.html"
    Dim fso As Object, hFile As Object, hString As String, html As MSHTML.HTMLDocument
    Set html = New MSHTML.HTMLDocument
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set hFile = fso.OpenTextFile(filePath)

    Do Until hFile.AtEndOfStream
        hString = hFile.ReadAll()
    Loop

    html.body.innerHTML = hString
    Set GetHTMLFileContent = html
End Function

Public Function GetHTMLFromFile(ByVal url As String) As String
    Dim fso As Object, f As Object, outputString As String

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile("C:\Users\HarrisQ\Desktop\HTML.txt", 1)

    Do Until f.AtEndOfStream
        outputString = f.ReadAll()
    Loop
    f.Close

    GetHTMLFromFile = outputString
End Function

Если у вас уже есть строка, вы можете просто напрямую присвоить html документ с

Set html = New MSHTML.HTMLDocument
html.body.innerHTML = yourTableString ' no need for function call to read html and return HTMLDocument

Answer 2

Вот пример подхода:

Sub Tester()
    Dim arr
    With ActiveSheet
        'parse HTML (stored in a worksheet cell)
        arr = HTMLTableToArray(.Range("A1").Value)
        'put the array onto the sheet
        .Range("B3").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End With
End Sub


'convert a regular HTML table (no merged cells etc) to a 2D array
Function HTMLTableToArray(HTMLText As String)
    Dim o As New HTMLDocument, tbl
    Dim nr As Long, nc As Long, r As Long, c As Long
    o.body.innerHTML = HTMLText
    DoEvents
    Set tbl = o.getElementsByTagName("table")(0)
    nr = tbl.Rows.Length
    nc = tbl.Rows(0).Cells.Length
    ReDim arr(1 To nr, 1 To nc) 'size output array
    'loop over rows and cells and fill the array
    For r = 1 To nr
        For c = 1 To nc
            arr(r, c) = tbl.Rows(r - 1).Cells(c - 1).innerText
        Next c
    Next r
    HTMLTableToArray = arr
End Function

Примечание: это предполагает, что ваша строка HTML верна и содержит полную таблицу HTML без объединенных ячеек (ie .не использовать rowspan или colspan)