Jak pobrać zawartość strony internetowej do arkusza

W jednym z projektów musiałem pobrać zawartość strony internetowej do arkusza. Niestety nie mogłem użyć wbudowanych narzędzi Excela z racji skomplikowania strony.

Poniżej prezentuję uproszczoną zawartość HTML strony. Moim zadaniem było pobranie każdego paragrafu <p> klasy <div class=”SomeClassNameChild”>, ale klasa <div class=”NextClassChildName”> która jest dzieckiem <div class=”SomeClassNameChild”> musiała znajdować się drugiej kolumnie arkusza.

Inne klasy miały być pominięte.

Przykładowy HTML:

<html>
<head></head>
	<body>
		<div class="SomeClassNameParent">

			<div class="SomeClassNameChild" id="child-1"> <!-- This class is duplicated many times -->
				<span class="icon-close"></span>
				<h5><span class="number">1</span> Some title</h5>
				<img src="SomePath data-src="SomePath" class="lazy" alt="">
				<p>Some text here #1</p>
				<p>Some text here #2</p>
				<p>&nbsp;</p>
				<p>Some text here #3</p>		
				<div class="NextClassChildName">
					<h6><span class="icon"></span>Text</h6>
					<p>Some text here #4</p>
				</div>
				<div class="NextClassChildName2">
					<button class="prev child-1" style="display:none">&lt; SomeButton</button>
					<button class="next child-1">SomeButton</button>		
			</div>

		</div>
	</body>
</html>

Kod w VBA wygląda następująco:

Private Sub DowloadloadWebContent()
' https://stackoverflow.com/questions/41558714/pull-value-from-website-html-div-class-using-excel-vba
' https://stackoverflow.com/questions/14108948/excel-vba-check-if-entry-is-empty-or-not-space
' https://stackoverflow.com/questions/41851152/vba-web-scrape-getelementsbyclassname
' http://automatetheweb.net/vba-getelementsbytagname-method/
' https://stackoverflow.com/questions/46036355/extracting-div-class-information-from-website-with-vba

' Needed references (Go to Tools -> References):
' Microsoft HTML Object Library

Dim htmlEle1 As IHTMLElement
Dim HTMLDoc As HTMLDocument
Dim URL, NameOfClass As String
Dim SheetRowCounter, HtmlWebRowCounter, HtmlLineNumber As Long
Dim oElement As Object


URL = "Test_URL_Path"
Set HTMLDoc = New HTMLDocument

' Connect to WebPage
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", URL, False
    .send
    HTMLDoc.body.innerHTML = .responseText
End With

' Paste the HTML content to active sheet
With ActiveWorkbook.ActiveSheet

    ' Looping only <div> sections
    For Each htmlEle1 In HTMLDoc.getElementsByTagName("div")
                
        ' Get the name of selected class
        NameOfClass = htmlEle1.className
        Select Case NameOfClass
        
        Case "SomeClassNameChild" ' Catch SomeClassNameChild only
            SheetRowCounter = SheetRowCounter + 1
            
            ' Get SomeClassNameChild class index
            .Cells(SheetRowCounter, 1) = htmlEle1.getAttribute("id")

            ' Get title only <h5> of SomeClassNameChild
            HtmlWebRowCounter = -1
            For Each oElement In htmlEle1.getElementsByTagName("h5")
                .Cells(SheetRowCounter, 2) = .Cells(SheetRowCounter, 2) & _
                            " " & htmlEle1.getElementsByTagName("h5")(HtmlWebRowCounter + 1).innerText
                HtmlWebRowCounter = HtmlWebRowCounter + 1
            Next

            ' Get all <p> of SomeClassNameChild
            HtmlWebRowCounter = -1
            For HtmlLineNumber = 0 To UBound(Split(htmlEle1.innerHTML, vbCrLf))
                ' Eliminate class NextClassChildName from loop
                If Split(htmlEle1.innerHTML, vbCrLf)(HtmlLineNumber) = "<DIV class=NextClassChildName>" Then
                    Exit For
                Else
                    If Left(Split(htmlEle1.innerHTML, vbCrLf)(HtmlLineNumber), 3) = "<P>" Then
                        .Cells(SheetRowCounter, 3) = .Cells(SheetRowCounter, 3) & _
                            " " & htmlEle1.getElementsByTagName("p")(HtmlWebRowCounter + 1).innerText
                        HtmlWebRowCounter = HtmlWebRowCounter + 1
                    End If
                End If
            Next
            
            ' in this web page some of descriptions are not placed in <p> but in <div> directly or in <p class="name">
            ' for that reason here is a try to catch this line descriptions and paste in to proper cell
            HtmlWebRowCounter = -1
            If .Cells(SheetRowCounter, 3) = "" Or Len(Trim(.Cells(SheetRowCounter, 2))) = 0 Then
                For HtmlLineNumber = 0 To UBound(Split(htmlEle1.innerHTML, vbCrLf))
                    If Split(htmlEle1.innerHTML, vbCrLf)(HtmlLineNumber) = "<DIV class=NextClassChildName>" Then
                        Exit For
                    Else
                        If Left(Split(htmlEle1.innerHTML, vbCrLf)(HtmlLineNumber), 5) = "<DIV>" Then
                            .Cells(SheetRowCounter, 3) = .Cells(SheetRowCounter, 3) & _
                                " " & htmlEle1.getElementsByTagName("div")(HtmlWebRowCounter + 1).innerText
                            HtmlWebRowCounter = HtmlWebRowCounter + 1
                        End If
                    End If
                Next
            End If

        ' Get <p> of NextClassChildName class. <h6> tag should not be considered
        Case "NextClassChildName2"
        
            HtmlWebRowCounter = -1
            For Each oElement In htmlEle1.getElementsByTagName("p")
                .Cells(SheetRowCounter, 4) = .Cells(SheetRowCounter, 4) & _
                    " " & htmlEle1.getElementsByTagName("p")(HtmlWebRowCounter + 1).innerText
                HtmlWebRowCounter = HtmlWebRowCounter + 1
            Next
            
        ' Class <div class="NextClassChildName2"> is not considered (no case) in loop. No data is taken from there
            
        End Select
    Next
End With

End Sub

Ciekawymi elementami są:

Wyodrębnienie pojedyńczych linii HTML z całości stringa:

Split(htmlEle1.innerHTML, vbCrLf)(HtmlLineNumber)

Obliczenie ilości wierszy w HTML stringu:

UBound(Split(htmlEle1.innerHTML, vbCrLf))

Sprawdzenie czy komórka jest pusta pomimo pobrania wartości <p>&nbsp;</p>, gdzie o ile dobrze pamiętam samo LEN zwracało liczbę 2:

Len(Trim(.Cells(SheetRowCounter, 2))) = 0

Warto tez zwrócić uwagę, że do pobrania zawartości używam dwóch właściwości:
innerText: do pobrania samego tekstu np. z tagu <p>,
innerHTML: do poruszania się po HTMLu (pętla) i odszukania interesujących elementów.

Dodaj komentarz

Twój adres email nie zostanie opublikowany. Wymagane pola są oznaczone *

Witryna wykorzystuje Akismet, aby ograniczyć spam. Dowiedz się więcej jak przetwarzane są dane komentarzy.