Ophalen voertuiggegevens van meerdere kentekens

Status
Niet open voor verdere reacties.
R

riw

Gebruiker
Lid geworden
30 jan 2017
Berichten
46
In het bijgevoegde bestand kan ik door middel van een kenteken voertuiggegevens ophalen. Deze werkte met cel A3. De opgehaalde gegevens worden dan geplaatst in B3, C3 etc. Hoe kan ik er voor zorgen dat ik ook in A4 en A5 etc kentekens in kan voeren, en dat de cellen B4 en C4 vervolgens gevuld worden?
 

Bijlagen

  • BPM.xlsm
    65,6 KB · Weergaven: 38
Heb je wel het goede bestand meegestuurd? Als ik het kenteken nr verander, dan gebeurt er niks. En ik zie ook geen macro's die de klus opknappen, of formules die dat doen. Je mag wel íets meer prijsgeven van je werkwijze :).
 
Bedankt voor je terugkoppeling. Je hebt gelijk. In cel A1 zit een knop die de macro aanstuurt.
 
De knop had ik nog niet gezien. Zal de volgende keer de plaat voor 'm kop vervangen door een werkende bril :cool:
 
Je kan het zo eens proberen:
Code: 
Sub Kentekeninfo()
    ' Ophalen van de kenteken gegevens
    Set httpObject = CreateObject("MSXML2.XMLHTTP")
    i = 1
    Do While Not Range("A2").Offset(i, 0) = ""
        Set rng = Range("A2").Offset(i, 0)
        sURL = "https://opendata.rdw.nl/resource/m9d7-ebf2.json?kenteken=" + rng.Value
        sRequest = sURL
        httpObject.Open "GET", sRequest, False
        httpObject.send
        result = httpObject.responseText
        'Parsen van de retour gekomen JSON
        Set json = JsonConverter.ParseJson(result)
        rng.Offset(0, 1).Value = json(1)("merk")
        rng.Offset(0, 2).Value = json(1)("handelsbenaming")
        rng.Offset(0, 6).Value = json(1)("bruto_bpm")
        rng.Offset(0, 7).Value = json(1)("catalogusprijs")
        i = i + 1
    Loop
    
End Sub

Code: 
Sub Brandstof()
Dim httpObject As Object, result As String, json As Object
Dim i As Integer
Dim rng As Range
    ' Ophalen van de kenteken gegevens
    Set httpObject = CreateObject("MSXML2.XMLHTTP")
    i = 1
    Do While Not Range("A2").Offset(i, 0) = ""
        Set rng = Range("A2").Offset(i, 0)
        sURL = "https://opendata.rdw.nl/resource/8ys7-d773.json?kenteken=" + rng.Value 
        sRequest = sURL
        httpObject.Open "GET", sRequest, False
        httpObject.send
        result = httpObject.responseText
        'Parsen van de retour gekomen JSON
        Set json = JsonConverter.ParseJson(result)
        rng.Offset(0, 5).Value = json(1)("brandstof_omschrijving")
        i = i + 1
    Loop
End Sub

Code: 
Sub Carrosserie()
Dim httpObject As Object, result As String, json As Object
Dim i As Integer
Dim rng As Range
    ' Ophalen van de kenteken gegevens
    Set httpObject = CreateObject("MSXML2.XMLHTTP")
    i = 1
    Do While Not Range("A2").Offset(i, 0) = ""
        Set rng = Range("A2").Offset(i, 0)
        sURL = "https://opendata.rdw.nl/resource/vezc-m2t6.json?kenteken=" + rng.Value
        sRequest = sURL
        httpObject.Open "GET", sRequest, False
        httpObject.send
        result = httpObject.responseText
        Set json = JsonConverter.ParseJson(result)
        rng.Offset(0, 4).Value = json(1)("type_carrosserie_europese_omschrijving")
        i = i + 1
    Loop
End Sub
 
Laatst bewerkt:
Laatst bewerkt:
Goed te zien dat het ook met meer code kan.

Code: 
Sub M_snb()
    a = Split("merk handelsbenaming inrichting brandstof bruto_bpm")
    c00 = Sheet1.Cells(2, 1).Text
    
    With CreateObject("MSXML2.XMLHTTP")
      .Open "GET", "http://opendata.rdw.nl/resource/m9d7-ebf2.json?kenteken=" & c00, False
      .send
      sn = Split(Replace(Replace(.responsetext, Chr(34), ""), ":", "|:"), ",")
            
      sp = Filter(Split(Join(Array(Filter(sn, a(0))(0), Filter(sn, a(1))(0), Filter(sn, a(2))(0), Filter(sn, a(3))(0), Filter(sn, a(4))(0)), ":"), ":"), "|", 0)

      .Open "GET", "http:" & sp(3) & "?kenteken=" & c00, False
      .send
      sp(3) = Split(Filter(Split(Replace(.responsetext, Chr(34), ""), ","), a(3) & "_omschrijving")(0), ":")(1)
    End With
    Sheet1.Cells(3, 2).Resize(, UBound(sp) + 1) = sp
End Sub
 
Laatst bewerkt:
OctaFish zei:
Je kan het zo eens proberen:
Klik om te vergroten...

Dank je wel voor terugkoppeling. Er zit een verschuiving in. Vanaf rij D staan de opgehaalde gegevens een rij te veel naar rechts. De "inrichting" staat onder "brandstof". Ik heb gekeken naar de offset. Maar die staat volgens mij wel goed.
 
edmoor zei:
Daar is geen knop voor nodig.
Vul een kenteken in kolom A in op bijvoorbeeld regel 2:
Bekijk bijlage 359924
Klik om te vergroten...

Dank je wel voor je toevoeging. Deze kan/ga ik in een andere opzet gebruiken. Ik heb geprobeerd om de knop weer toe te voegen maar krijg dan een foutmelding bij de sURL.

Ik kom ook de volgende regel tegen. "On Local Error Resume Next" Kan je aangeven wat deze regel doet?
 
snb zei:
Goed te zien dat het ook met meer code kan.
Klik om te vergroten...

Dank je wel voor je hulp. Als ik het goed lees corresponderen de Filters met de Split uit de eerste regel. Het lijkt er op dat mijn overige vereiste, geen streepjes en omzetten naar hoofdletters, niet werken. Tevens krijg ik alleen gegevens voor een kenteken wat in cel A2 staat. Klopt dat?
 
Kolommen en rijen zijn verschillende zaken.
De code kun je zelf aanpassen.
Ik heb me beperkt tot de essentie.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan