Gegevens ophalen van website d.m.v. VBA

[L@urence]

Een bijzonder goedemiddag,

Ik ben nog niet heel vaardig met VBA maar kom met informatie op internet vaak een heel eind. Echter loop ik nu vast. Ik probeer het oppervlakte van de kadasterwebsite te kopiëren naar een excel sheet d.m.v. VBA. Ik heb een simpele opzet gemaakt:

Sub oppervlakte()
    Dim IE As Object

    
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False
   
    IE.Navigate "https://bagviewer.kadaster.nl/lvbag/bag-viewer/#?searchQuery=aluin%207%20zoetermeer"

    Application.StatusBar = "Pagina laden"

    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Application.StatusBar = "Waarde zoeken"

    Dim dd As String
    dd = IE.Document.getElementsByClassName("col-xs-7 ng-binding")(0).innerText

    Cells(1, 1).Value = dd
  
    Set IE = Nothing

    Application.StatusBar = ""
 
End Sub

De waarde die ik nu terug krijg is het bouwjaar (1994). Ik heb gezien dat er gebruikt wordt gemaakt van dezelfde html classes (col-xs-7 ng-binding). Het bouwjaar is de eerste en wordt daarom weergegeven. Ook is deze code niet erg betrouwbaar, omdat ik de code soms meerdere keren moet uitvoeren om tot een resultaat te komen. Weet iemand hoe ik dit kan oplossen?

Alvast bedankt!:thumb:

 

[alphamax]

Option Explicit

Sub oppervlakte()
    Dim objNg As Object
    Dim objNgs As Object
    Dim objAtt As Object
    Dim objAtts As Object
    Cells(1, 1).Value = "Wacht tot het venster sluit."
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "https://bagviewer.kadaster.nl/lvbag/bag-viewer/#?searchQuery=aluin%207%20zoetermeer"
        Do
            DoEvents
        Loop While .Busy Or .readyState <> 4
        Application.Wait DateAdd("s", 5, Now)
        Set objNgs = .Document.getElementsByClassName("col-xs-7 ng-binding")
        For Each objNg In objNgs
            Set objAtts = objNg.Attributes
            For Each objAtt In objAtts
                If objAtt.Name = "ng-bind" And objAtt.Value = "bagObject.oppervlakte + ' m2'" Then
                    If Val(objNg.innertext) <> 0 Then
                        Cells(1, 1).Value = objNg.innertext
                    End If
                End If
            Next
            Set objAtts = Nothing
        Next
        Set objNgs = Nothing
        .Quit
    End With
End Sub

 

[L@urence]

Zo dat is een hele omschakeling. De code werkt super!, Hartstikke bedankt Alphamax!!! :thumb::thumb: