Google afstand postcodes berekenen

[thst]

Voor alle geintersseerden



Angela

 

[robdgr]

Angela,

De code die je geeft, werkt goed, behalve bij postcodes die minder dan één kilometer van elkaar af liggen. Ik heb eerder onderstaande code gevonden en die pakt alle afstanden:

Option Explicit

Public Function GetPage(sLink As String) As XMLHTTP40
  Dim oObj     As MSXML2.XMLHTTP40
  Set oObj = New XMLHTTP40
  oObj.Open "GET", sLink, False
  oObj.send ""
  Set GetPage = oObj
End Function

Public Function afstand(Code1 As String, Code2 As String)
  
  Dim oResult  As XMLHTTP40
  Dim oDOM     As DOMDocument40
  Dim sStr     As String
  Dim sResult  As String
  Dim sURL     As String
  Const sKeyWords As String = "</strong> route over <strong>"
  sURL = "http://route.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
  sStr = oResult.responseText
  sStr = oResult.responseText
  sResult = Mid(sStr, InStr(sStr, sKeyWords) + Len(sKeyWords))
  sResult = Replace(Mid(sResult, 1, InStr(sResult, "m") - 1), ",", ".")
  afstand = Val(Left(sResult, Len(sResult) - 1)) * IIf(Right(sResult, 1) = "k", 1, 0.001)

End Function

Ook valt me op dat jouw code alle afstanden afrondt en de ANWB-code geeft decimalen.

 

[alphamax]

Ik heb eerder onderstaande code gevonden

ik heb nu (ouder en wijzer?) deze code gemaakt

Option Explicit

Function afstand(Postcode_1, Postcode_2)
    Dim avntRoute As Variant
    Dim strTemp As String
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", "http://route.anwb.nl/routeplanner/?action=0&country1=528&country2=528&invalidate=0&modality=car&over_country=-1&planmode=Fast&rtvMode=departure&skipcheck=0&zip1=" & Postcode_1 & "&zip2=" & Postcode_2, False 'am_2013
            .Send
            strTemp = .Responsetext
            With CreateObject("HTMLFile")
                .Body.Innerhtml = strTemp
                avntRoute = Split(Filter(Split(.Body.innertext, vbCrLf), "route over")(0), " ")
                afstand = IIf(avntRoute(4) = "km", 1, 0.001) * Val(Replace(avntRoute(3), ",", "."))
            End With
        End With
End Function