Trying to get data from the second table of this website as the first table only contains the elements of a drop list, for whatever reason this is included as a table in the HTML!
The code refers to a similar page in which, however, the first table is not present, there it works fine, just not on the page with two tables that have different contents.
So the idea is to use the code below, but first to skip the first table and extract only the contents of the second table (tr/td) that match the elements in the given array.
Does anyone have any idea how the code would have to be modified to handle this? Thanks!
Snippet with both tables (run the snippet to see the droplist):
<table border="1">
<tbody>
<tr>
<td>
<select size="1" onchange="nextpage(this.options[this.selectedIndex].value,'-1','-1')">
<option value="1-1-11">1-2</option>
<option value="all" selected="selected">all</option>
</select>
</td>
<td></td>
</tr>
</tbody>
</table>
<table border="0">
<tbody>
<tr>
<td>valign=“top“ aling“left“>
<nobr>Description</nobr></td>Code section including a function
Dim table As MSHTML.HTMLTable, R As Long, c As Long, headers(), row As MSHTML.HTMLTableRow
Dim results() As Variant, html2 As MSHTML.HTMLDocument
headers = Array("HDR01", " HDR02", " HDR03", " HDR04")
ReDim results(1 To 100, 1 To UBound(headers) + 1)
Set table = html.querySelector("table")
Set html2 = New MSHTML.HTMLDocument
Dim lastRow As Boolean
For Each row In table.Rows
Dim header As String
lastRow = False
html2.body.innerHTML = row.innerHTML
header = Trim$(row.Children(0).innerText)
If header = "Description" Then
R = R + 1
Dim dict As Scripting.Dictionary: Set dict = GetBlankDictionary(headers)
End If
If dict.Exists(header) Then
dict(header) = Trim$(row.Children(1).innerText)
End If
....
If lastRow Then
populateArrayFromDict dict, results, R
End If
Next
With ActiveSheet
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
The function:
Public Function GetBlankDictionary(ByRef headers() As Variant) As Scripting.Dictionary
Dim dict As Scripting.Dictionary, i As Long
Set dict = New Scripting.Dictionary
For i = LBound(headers) To UBound(headers)
dict(headers(i)) = vbNullString
Next
Set GetBlankDictionary = dict
End Function
I need something like this that works:
If table.Border = "1" Then 'with Droplist
Set table = html.querySelectorAll("body").Item(1) 'skip table0
ElseIf table.Border = "0" Then 'wihtout Droplist
Set table = html.querySelectorAll("body").Item(0) 'start with this table
End If
