anwb code om afstand te berekenen werkt niet meer

[jelleke68]

Beste forumleden,

Ik had hier de geweldige code om de snelste afstand tussen onze 4 bedrijfspostcodes gevonden. Vorige week had ik de code nog even aangepast en werkte hij nog, echter sinds vandaag is de oude site uit de lucht. Kan iemand mij helpen aan de nieuwe codes?

  [I]Const sKeyWords As String = "</strong> route over <strong>"
  sURL = "http://route1.anwb.nl/routeplanner/servlet/rp?action=0&zip1="
  sURL = sURL & Code1 & "&city1=&street1=&zip2="
  sURL = sURL & Code2 & "&city2=&street2=&iad=homepage.navigatie.middenkolom.routeplannerplanroute"
  Set oResult = GetPage(sURL)
  Set oDOM = New DOMDocument40
  On Error Resume Next

 

[Warme bakkertje]

Op Worksheet.nl dezelfde vraag gezien.
Dit was het antwoord van Alphamax, een autoriteit in het ophalen van gegevens van het internet.

Ik heb even snel gekeken naar de nieuwe site, maar ik ben bang dat het moeilijker is geworden (javascript met aanvraag-id's).

Tot op heden heeft hij nog niet terug gereageerd, dus afwachten maar.

 

[alphamax]

Dit werkt alvast (getest met windows7en, excel2007nl en IE11en)

Option Explicit

Public Function AfstandANWB(strName1 As String, strName2 As String) As String
    Dim objAll As Object
    Dim objDiv As Object
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "http://www.anwb.nl/verkeer/routeplanner?name1=" & strName1 & "&modality1=car&routeType1=fast&name2=" & strName2    'am_2014
        Do While .Busy Or .ReadyState <> 4
            DoEvents
        Loop
        Application.Wait (Now() + TimeValue("00:00:01"))
        For Each objDiv In .Document.GetElementsByTagName("div")
            If objDiv.ClassName = "informatie routeInfo" Then
                For Each objAll In objDiv.GetElementsByTagName("*")
                    If objAll.ClassName = "distance" Then
                        '                        AfstandANWB = objAll.getAttribute("data-distance")  'lengte in meters, waarde zonder eenheid
                        AfstandANWB = objAll.InnerText    'lengte in meters/kilometers, waarde met eenheid
                    End If
                Next
            End If
        Next
        .Quit
    End With
End Function