Webscraping gegevens ophalen van een website

Nog een keer data van een website halen met VBA code. Ga in de Visual Basic Editor naar:
Extra | Verwijzingen en kruis in ieder geval aan:

– Microsoft HTML Object Library
– Microsoft XML, v6.0

De VBA code

Sub Get_That_Data_Version_2()
    Dim HTMLdoc As Object
    Dim xmlhttp As New MSXML2.XMLHTTP60
    Dim allDivs As Object, element As Object
    Dim i As Integer
    Dim ws As Worksheet
    Dim nextRow As Long
    
    ' Wijs Sheet1 toe en maak de sheet leeg voor nieuwe data
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ws.Cells.Clear
    
    ' Schrijf de kolomkoppen in A1, B1 en C1
    ws.Range("A1").Value = "Platform"
    ws.Range("B1").Value = "Title"
    ws.Range("C1").Value = "Price"
    
    ' Zet de startrij voor de data op rij 2
    nextRow = 2
    
    Set xmlhttp = New MSXML2.XMLHTTP60
    xmlhttp.Open "GET", "https://gameshop.nl/webshop/index.php", False
    xmlhttp.send
    
    Set HTMLdoc = CreateObject("htmlfile")
    HTMLdoc.body.innerHTML = xmlhttp.responseText
    
    Set allDivs = HTMLdoc.getElementsByTagName("div")
    
    For i = 0 To allDivs.Length - 1
        Set element = allDivs.Item(i)
        
        If element.className Like "*product-card*" Then
            ' Geef het werkblad en de huidige rij mee als argumenten
            Extract_Product_Data element, ws, nextRow
        End If
    Next i
    
    ' Kolommen automatisch netjes uitlijnen qua breedte
    ws.Columns("A:C").AutoFit
    MsgBox "Data succesvol geëxporteerd naar Sheet1!", vbInformation
End Sub

Private Sub Extract_Product_Data(ByVal productBox As Object, ByVal ws As Worksheet, ByRef nextRow As Long)
    Dim subElements As Object, subEl As Object
    Dim j As Integer
    Dim platformText As String, titleText As String, priceText As String
    
    Set subElements = productBox.getElementsByTagName("*")
    
    For j = 0 To subElements.Length - 1
        Set subEl = subElements.Item(j)
        
        ' 1. PLATFORM
        If UCase(subEl.tagName) = "A" Then
            If subEl.getAttribute("href") Like "*platform=*" Then
                platformText = subEl.innerText
            End If
        End If
        
        ' 2. TITEL
        If UCase(subEl.tagName) = "H3" Then
            If subEl.getElementsByTagName("a").Length > 0 Then
                titleText = subEl.getElementsByTagName("a").Item(0).innerText
            Else
                titleText = subEl.innerText
            End If
        End If
        
        ' 3. PRIJS
        If subEl.className Like "*prijs*" Then
            priceText = subEl.innerText
        End If
    Next j
    
    ' Schrijf het resultaat naar Sheet1 in plaats van het Immediate Window
    If titleText <> "" Or priceText <> "" Then
        ws.Cells(nextRow, 1).Value = Trim(platformText) ' Kolom A
        ws.Cells(nextRow, 2).Value = Trim(titleText)    ' Kolom B
        ws.Cells(nextRow, 3).Value = Trim(priceText)    ' Kolom C
        
        ' Hoog de rij-teller op voor het volgende product
        nextRow = nextRow + 1
    End If
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *