Afstand berekenen tussen twee postcodes via google maps

[AndrettiH]

Ik heb via de forum al verschillende bestandjes gebruikt maar geen enkele doet wat ik graag wil. In cel A een postcode, in cel B een postcode en dan in cel C de afstand tussen deze twee postcodes berekend via de meest logische route in Google Maps.

 

[alphamax]

zie http://www.helpmij.nl/forum/showthr...-google-maps?p=4633659&viewfull=1#post4633659
en de kolommen die je niet nodig hebt kan je verbergen

 

[robdgr]

Ik gebruik deze code en die werkt nog steeds:

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

 

[pjotr0]

Postcode excel met google maps

Dag

Ik vind de resultaten van ANWB routeplanner niet altijd juist.
Ik heb er een gemaakt voor google maps:

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 GetDistanceBetweenPostCodes(Code1 As String, Code2 As String)
    Dim oResult As XMLHTTP40
    Dim oDOM As DOMDocument40
    Dim sStr As String
    Dim sResult As String
    Dim dResult As Variant
    Dim sURL As String
    Const sKeyWords As String = "km</span>"
    sURL = "http://maps.google.nl/maps?f=d&hl=nl&geocode=&saddr="
    sURL = sURL & Code1 & "+to:"
    sURL = sURL & Code2
    Set oResult = GetPage(sURL)
    Set oDOM = New DOMDocument40
    sStr = oResult.responseText
    sResult = Mid(sStr, InStr(sStr, sKeyWords) - Len(sKeyWords), Len(sKeyWords))
    sResult = Replace(sResult, "<", "")
    sResult = Replace(sResult, "s", "")
    sResult = Replace(sResult, "p", "")
    sResult = Replace(sResult, "a", "")
    sResult = Replace(sResult, "n", "")
    sResult = Replace(sResult, ">", "")
    sResult = Replace(sResult, " ", "")
    dResult = CDec(sResult)
    GetDistanceBetweenPostCodes = dResult
End Function

in de cel met resultaat zet je =GetDistanceBetweenPostCodes(A1, A2) als je de postcodes in A1 en A2 hebt
werkt ook als je andere zoeksleutes gebruikt zoals straat en woonplaats

als een zonnetje!

(de replace kan ook in één regel geloof ik, maar daar heb ik me niet in verdiept, als iemand hem nog kan opschonen, prima!)


succes ermee

 

[Warme bakkertje]

Zoals gevraagd, de compact-version.

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

Public Function GetDistanceBetweenPostCodes(Code1 As String, Code2 As String)
    'With GetPage("http://maps.google.be/maps?f=d&hl=b&geocode=&saddr=" & Code1 & "+to:" & Code2) 'België
    With GetPage("http://maps.google.nl/maps?f=d&hl=nl&geocode=&saddr=" & Code1 & "+to:" & Code2) 'Nederland
        GetDistanceBetweenPostCodes = CDec(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Mid _
        (.responseText, InStr(.responseText, "km</span>") - Len("km</span>"), Len("km</span>")), _
        "<", ""), "s", ""), "p", ""), "a", ""), "n", ""), ">", ""), " ", ""))
    End With
End Function

 

[snb]

Inderdaad: erg compact ...

Function F_afstand_snb(c01, c02)
    With New XMLHTTP60
        .Open "GET", "http://maps.google.nl/maps?f=d&hl=nl&geocode=&saddr=" & c01 & "+to:" & c02, False
        .send
        F_afstand_snb = Trim(Right(Split(.responseText, "km</span>")(0), 4))
    End With
End Function

Sub M_snb()
    MsgBox F_afstand_snb("6828CK", "5114AN")
End Sub

 

[alphamax]

@snb

door jouw testdata zou je denken dat de code niet werkt

voor wel goede testdata

De eerste postcode die een straat aangeeft is 1011 AA. Dat is de De Ruijterkade, de straat die achter het Centraal Station loopt. De hoogste postcode is 9999 ZZ, de Knolweg te Stitswerd.

bron: http://nl.wikipedia.org/wiki/Postcodes_in_Nederland

 

[alphamax]

Public Function GoogleMapsXMLDistance(rngOrigin As Range, rngDestination As Range) As Double
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" & rngOrigin.Value & "&destination=" & rngDestination.Value & "&alternatives=false&units=metric&sensor=false", False
        .send
        GoogleMapsXMLDistance = CDbl(.responseXML.SelectSingleNode("//leg/distance/value").Text) / 1000 'am_2012
    End With
End Function

Door het gebruik van XML krijgt men een gestructureerde response die niet gevoelig is voor verkeerde interpretatie.

 

[snb]

Een aantal argumenten lijkt niet noodzakelijk ?

Public Function F_afstand_XML(c01, c02)
  With New XMLHTTP                 '    With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" & c01 & "&destination=" & c02 & "&sensor=false", False
    .send
    F_afstand_XML = .responseXML.SelectSingleNode("//leg/distance/value").Text / 10 ^ 3
  End With
End Function

 

[Warme bakkertje]

@ snb of alphamax

Kan 1 van jullie beiden mij een verklaring geven waarom beide laatste functies een afwijkend resultaat geven met Belgische postnummers ?
Beide functies werken wel correct met Belgische plaatsnamen, Nederlandse postcodes en Nederlandse plaatsnamen.
Bv.
Merksem -- Westende ==> 145,919 km
Zelfde gemeentes maar in postcode
2170 -- 8434 ==> 1558,003 ?

 

[alphamax]

de gegevens functies zijn domme functies, ze geven gewoon het eerste resultaat van eventueel meerdere resultaten (ongeacht goed of fout)
zoals er meerdere plaatsen zijn met dezelfde naam (bern in zwitserland en in de provincie friesland), zijn er nog meer postcodes in de wereld met dezelfde code

eigenlijk moet je bij elke postcode het land vermelden, voeg overal ",belgie" toe en het gaat goed
controleer maar eens handmatig in google maps

 

[Warme bakkertje]

Duidelijk :thumb:

Bedankt