Vroeger kon ik met onderstaande code de afstand berekenen van twee locaties echter werkt dit niet meer.
Weet iemand een andere oplossing om de afstand te kunnen berekenen?
Weet iemand een andere oplossing om de afstand te kunnen berekenen?
Code:
Public Function Shortest(strOrigin As String, strDestination As String) As Variant 'meters
Dim lngDistance As Long
Dim objResult As Object
Dim strResponseXML As String
Dim strStatus As String
With CreateObject("MSXML2.XMLHTTP")
strURL3 = "http://maps.googleapis.com/maps/api/directions/xml?origin=" & strOrigin & "&destination=" & strDestination & "&alternatives=true&language=nl&units=metric&sensor=false"
.Open "GET", strURL3, False 'am_2015
.Send
If .Status = 200 Then
strResponseXML = .ResponseText
With CreateObject("MSXML2.DOMDOCUMENT")
.LoadXML strResponseXML
strStatus = .SelectSingleNode("//status").Text
If strStatus = "OK" Then
Shortest = 9E+18
For Each objResult In .SelectNodes("//leg/distance/value")
lngDistance = CLng(objResult.Text)
If lngDistance < Shortest Then
Shortest = lngDistance
End If
Next
Else
Shortest = strStatus
End If
End With
Else
Shortest = "ERROR"
End If
End With
End Function
Public Function Fastest(strOrigin As String, strDestination As String) As Variant 'seconds
Dim lngDuration As Long
Dim objResult As Object
Dim strResponseXML As String
Dim strStatus As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" & strOrigin & "&destination=" & strDestination & "&alternatives=true&language=nl&units=metric&sensor=false", False 'am_2015
.Send
If .Status = 200 Then
strResponseXML = .ResponseText
With CreateObject("MSXML2.DOMDOCUMENT")
.LoadXML strResponseXML
strStatus = .SelectSingleNode("//status").Text
If strStatus = "OK" Then
Fastest = 9E+18
For Each objResult In .SelectNodes("//leg/duration/value")
lngDuration = CLng(objResult.Text)
If lngDuration < Fastest Then
Fastest = lngDuration
End If
Next
Else
Fastest = strStatus
End If
End With
Else
Fastest = "ERROR"
End If
End With
End Function