calculate distance and duration using google map

Hi,

What co-ordinate system will be using for the locations?

Originally Posted by liorom

no co-ordinate , just name the origin city and destination city. thanks

If you could indicate how you would calculate or get your answer without the aid of Excel, i.e. understand your thought process maybe we could replicate that in Excel.

Otherwise why not use one of the many calculators on the web. e.g. http://www.distancecalculator.net/

Hi,

If you're saying that you want to do this without holding any information in the workbook and want to obtain it from a web site then you'll need to find a web site that lists this information and then use an Excel Data Connection to grab the data when you enter two cities.

Otherwise one way or another you will need to have either a 2 dimensional matrix of all the cities/towns you're interested in with the names as both column labels and row labels and the distance between them at the intersection. i.e. the usual sort of triangular matrix you see in road atlases.

Or you could pick an arbitrary city and in a two column list list all cities in the first column and the distance to the arbitrary city in the column alongside. Then once Excel knows the two cities you're interested in it could use Pythagoras's theorem to work out the distance between the two - ignoring the inevitable small error because the surface is actually on a sphere rather than a flat plane.

Use this code as a macro, then use =getgoogledistance for distance, =getgoogletraveltime for travel time.

Const strUnits = "imperial" ' imperial/metric (miles/km)
 
Function CleanHTML(ByVal strHTML)
'Helper function to clean HTML instructions
Dim strInstrArr1() As String
Dim strInstrArr2() As String
Dim s As Integer
 
strInstrArr1 = Split(strHTML, "<")
For s = LBound(strInstrArr1) To UBound(strInstrArr1)
   strInstrArr2 = Split(strInstrArr1(s), ">")
   If UBound(strInstrArr2) > 0 Then
        strInstrArr1(s) = strInstrArr2(1)
   Else
        strInstrArr1(s) = strInstrArr2(0)
   End If
Next
  
CleanHTML = Join(strInstrArr1)
End Function
 
 
Public Function formatGoogleTime(ByVal lngSeconds As Double)
'Helper function. Google returns the time in seconds, so this converts it into time format hh:mm
  
Dim lngMinutes As Long
Dim lngHours As Long
  
lngMinutes = Fix(lngSeconds / 60)
lngHours = Fix(lngMinutes / 60)
lngMinutes = lngMinutes - (lngHours * 60)
  
formatGoogleTime = Format(lngHours, "00") & ":" & Format(lngMinutes, "00")
End Function
 
 
Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = "") As Boolean
On Error GoTo errorHandler
' Helper function to request and process XML generated by Google Maps.
 
Dim strURL As String
Dim objXMLHttp As Object
Dim objDOMDocument As Object
Dim nodeRoute As Object
Dim lngDistance As Long
 
Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objDOMDocument = CreateObject("MSXML2.DOMDocument.6.0")
  
strStartLocation = Replace(strStartLocation, " ", "+")
strEndLocation = Replace(strEndLocation, " ", "+")
  
strURL = "http://maps.googleapis.com/maps/api/directions/xml" & _
            "?origin=" & strStartLocation & _
            "&destination=" & strEndLocation & _
            "&sensor=false" & _
            "&units=" & strUnits
With objXMLHttp
    .Open "GET", strURL, False
    .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
    .Send
    objDOMDocument.LoadXML .ResponseText
End With
  
With objDOMDocument
    If .SelectSingleNode("//status").Text = "OK" Then
        'Get Distance
        lngDistance = .SelectSingleNode("/DirectionsResponse/route/leg/distance/value").Text ' Retrieves distance in meters
        Select Case strUnits
            Case "imperial": strDistance = Round(lngDistance * 0.00062137, 1)  'Convert meters to miles
            Case "metric": strDistance = Round(lngDistance / 1000, 1) 'Convert meters to miles
        End Select
         
        'Get Travel Time
        strTravelTime = .SelectSingleNode("/DirectionsResponse/route/leg/duration/value").Text  'returns in seconds from google
        strTravelTime = formatGoogleTime(strTravelTime) 'converts seconds to hh:mm
         
        'Get Directions
        For Each nodeRoute In .SelectSingleNode("//route/leg").ChildNodes
            If nodeRoute.BaseName = "step" Then
                strInstructions = strInstructions & nodeRoute.SelectSingleNode("html_instructions").Text & " - " & nodeRoute.SelectSingleNode("distance/text").Text & vbCrLf
            End If
        Next
         
        strInstructions = CleanHTML(strInstructions) 'Removes MetaTag information from HTML result to convert to plain text.
         
    Else
        strError = .SelectSingleNode("//status").Text
        GoTo errorHandler
    End If
End With
  
gglDirectionsResponse = True
GoTo CleanExit
  
errorHandler:
    If strError = "" Then strError = Err.Description
    strDistance = -1
    strTravelTime = "00:00"
    strInstructions = ""
    gglDirectionsResponse = False
  
CleanExit:
    Set objDOMDocument = Nothing
    Set objXMLHttp = Nothing
  
End Function
  
 
Function getGoogleTravelTime(ByVal strFrom, ByVal strTo) As String
'Returns the journey time between strFrom and strTo
  
Dim strTravelTime As String
Dim strDistance As String
Dim strInstructions As String
Dim strError As String
 
If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleTravelTime = strTravelTime
Else
    getGoogleTravelTime = strError
End If
  
End Function
  
 
Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String
'Returns the distance between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google

  
Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String
 
If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleDistance = strDistance
Else
    getGoogleDistance = strError
End If
  
End Function
 
 
Function getGoogleDirections(ByVal strFrom, ByVal strTo) As String
'Returns the directions between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google

  
Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String
 
If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
    getGoogleDirections = strInstructions
Else
    getGoogleDirections = strError
End If
  
End Function

Sub Mileage()

End Sub

Unfortunately your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

omitted post

Originally Posted by carsto

Not starting a new thread because I believe it pertains specifically to this thread.

Nevertheless you should start a new thread and if necessary link to this one.
This one is getting on for three years old and only original participators are likely to see it. You'll get more of a response by starting your own.