Webscrape VBA with if condition - html

Question

I am trying to import the bullet point from a website into an excel table (each bulletpoint filling with a li tag).
Yet I am facing an important difficulty as some page I would like to scrape have several "Part" (Part #1, Part #2, like this one https://www.thewindpower.net/windfarm_en_793_virtsu-i.php) and other haven't (like this one https://www.thewindpower.net/windfarm_en_7410_khizi.php)
I having already come up with a draft of a code that I believe could start, yet, I still have some issue and I get an error message ("Time out").
Do you have any idea how I could fix it ?
Thanks in advance for your help,
Sub Page()
GetPage ("https://www.thewindpower.net/windfarm_en_1922_a-capelada-i.php")
End Sub
Sub GetPage(URL As String)
Dim count As Integer
Dim Request As MSXML2.ServerXMLHTTP60: Set Request = New MSXML2.ServerXMLHTTP60
Dim Result As HTMLDocument: Set Result = New HTMLDocument
Request.Open "GET", URL, False
Request.send
Result.body.innerHTML = Request.responseText
Dim oRows As MSHTML.IHTMLElementCollection
Dim oRow As MSHTML.IHTMLElement
Dim oCells As MSHTML.IHTMLElementCollection
Dim oCell As MSHTML.IHTMLElement
Dim oLinks As MSHTML.IHTMLElementCollection
'Set Generalities
Set oRows = Result.getElementsByTagName("ul")(4).getElementsByTagName("li")
Dim iRow As Integer 'output li counter
Dim iColumn As Integer 'output column counter
Dim Sheet As Worksheet 'output sheet
iRow = 1
iColumn = 1
Set Sheet = ThisWorkbook.Worksheets("Sheet1")
count = Result.getElementsByTagName("h3").Length
If count > 0 Then
'# f Part on the page, 2 for the moment
Dim p As Integer
Dim o As Integer
p = count / 2
'Counter for each Part identified
For o = 1 To p
'Set Generalities data
iRow = 1
iColumn = 1
For Each oRow In oRows
Set oCells = oRow.getElementsByTagName("li")
For Each oCell In oCells
Sheet.Cells(iRow, iColumn).Value = oCell.innerText
iColumn = iColumn + 1
Next oCell
iRow = iRow + 1
Next oRow
'Set Detail data
Set oRows2 = Result.getElementsByTagName("h3")(o).getElementsByTagName("li")
For Each oRow In oRows2
Set oCells = oRow.getElementsByTagName("li")
For Each oCell In oCells
Sheet.Cells(iRow, iColumn).Value = oCell.innerText
iColumn = iColumn + 1
Next oCell
iRow = iRow + 1
iColumn = 1
Next oRow
iRow = iRow + 1
'insert a row
Range("iRow").Insert CopyOrigin:=xlFormatFromRightOrBelow
'increment Part counter
Next o
Else
'Set Generalities data
For Each oRow In oRows
Set oCells = oRow.getElementsByTagName("li")
For Each oCell In oCells
Sheet.Cells(iRow, iColumn).Value = oCell.innerText
iColumn = iColumn + 1
Next oCell
iRow = iRow + 1
Next oRow
'Set Detail data
Set oRows2 = Result.getElementsByTagName("ul")(5).getElementsByTagName("li")
For Each oRow In oRows2
Set oCells = oRow.getElementsByTagName("li")
For Each oCell In oCells
Sheet.Cells(iRow, iColumn).Value = oCell.innerText
iColumn = iColumn + 1
Next oCell
iRow = iRow + 1
iColumn = 1
Next oRow
End If
End Sub

Answer 1

Summary
I would gather a nodeList via css selectors to match on the relevant nodes. I would have two separate nodeLists. One for the generalities and another for the parts. I would determine the number of parts (as they repeat) and loop to those number of parts; concatenating the html for the repeated part that comes later with the former. Then put that combined html into a surrogate HTMLDocument variable and make a new nodeList of all the li elements contained. Use a helper function to return the text of the nodeList nodes in an array and then write that out to the sheet on a new combined text per row basis.
VBA:
Option Explicit
Public Sub WindInfo()
'VBE> Tools > References:
'1. Microsoft, XML v6
'2. Microsoft HTML Object Library
'3. Microsoft Scripting Runtime
Dim xhr As MSXML2.XMLHTTP60: Set xhr = New MSXML2.XMLHTTP60
Dim html As MSHTML.HTMLDocument: Set html = New MSHTML.HTMLDocument
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
With xhr
.Open "GET", "https://www.thewindpower.net/windfarm_en_7410_khizi.php", False
.send
html.body.innerHTML = .responseText
End With
Dim generalities As Object, arrGen(), partsList As Object
Dim r As Long
Set generalities = html.querySelectorAll("#bloc_texte table ~ table li")
arrGen = GetNodesTextAsArray(generalities)
Dim parts As Object, numberOfParts As Long
Set partsList = html.querySelectorAll("h1 ~ h3, ul ~ h3")
r = 1
If partsList.Length > 0 Then
numberOfParts = html.querySelectorAll("h1 ~ h3, ul ~ h3").Length / 2
Set parts = html.querySelectorAll("h3 + ul")
Dim i As Long, liNodes As Object, arr()
Dim html2 As MSHTML.HTMLDocument: Set html2 = New MSHTML.HTMLDocument
For i = 0 To numberOfParts - 1
ws.Cells(r, 1).Resize(1, UBound(arrGen)) = arrGen
html2.body.innerHTML = parts.Item(i).outerHTML & parts.Item(i + numberOfParts).outerHTML
Set liNodes = html2.querySelectorAll("li")
arr = GetNodesTextAsArray(liNodes)
ws.Cells(r, 5).Resize(1, UBound(arr)) = arr
r = r + 1
Next
Else
Dim alternateNodeList As Object: Set alternateNodeList = html.querySelectorAll("#bloc_texte h1 + ul")
If alternateNodeList.Length >= 1 Then
arr = GetNodesTextAsArray(alternateNodeList.Item(1).getElementsByTagName("li"))
Else
arr = Array("No", "Data", vbNullString)
End If
ws.Cells(r, 1).Resize(1, UBound(arrGen)) = arrGen
ws.Cells(r, 5).Resize(1, UBound(arr)) = arr
End If
End Sub
Public Function GetNodesTextAsArray(ByVal nodeList As Object) As Variant()
Dim i As Long, results()
If nodeList.Length = 0 Then
GetNodesTextAsArray = Array("No", "Data", vbNullString)
Exit Function
End If
ReDim results(1 To nodeList.Length)
For i = 0 To nodeList.Length - 1
results(i + 1) = nodeList.Item(i).innerText
Next i
GetNodesTextAsArray = results
End Function
References:
CSS selectors