Driving Times and miles from Google Maps.

[Olivia]

Sponsored Links

It would be very kind of you if you help me. I would like to have a spreadsheet which looks and retrieves data from Google maps so that whenever I input the destinations in two addresses or landmarks, it would show me the driving time and driving miles such as for example:

• Input will be:
• A1 = Start Address
• A2 = End Address
  ---------------------------------
  And Output should be:
• A3 = Journey Time
• A4 = Miles

[Vandam]

I personally appreciate your thinking and motive. To get data from Google about driving time and driving miles you have to do some tricky and complicated coding. Below there is a vba coding for same. Just have a glance on it and use it in yours.

Public Function getGoogDistanceTime(startAddr As String, startCity As String, _
    startState As String, startZip As String, endAddr As String, _
    endCity As String, endState As String, endZip As String) As String
     
    Dim sURL As String
    Dim BodyTxt As String
     
    sURL = "http://maps.google.com/maps?f=d&source=s_d&saddr="
    sURL = sURL & Replace(startAddr, " ", "+") & ",+" & Replace(startCity, " ", "+") & ",+" & startState
    sURL = sURL & "&daddr=" & Replace(endAddr, " ", "+") & ",+" & Replace(endCity, " ", "+") & ",+" & endState
    sURL = sURL & "&hl=en"
     
    BodyTxt = getHTML(sURL)
     
    If InStr(1, BodyTxt, "distance:""") = 0 Then getGoogDistanceTime = "Error": Exit Function
     
    getGoogDistanceTime = parseGoog("distance", BodyTxt) & " / " & parseGoog("time", BodyTxt)
     
End Function
 
Public Function getHTML(strURL As String) As String
     'Returns the HTML code underlying a given URL
    Dim oXH As Object
    Set oXH = CreateObject("msxml2.xmlhttp")
    With oXH
        .Open "get", strURL, False
        .send
        getHTML = .responseText
    End With
    Set oXH = Nothing
End Function

Public Function parseGoog(strSearch As String, strHTML As String) As String
strSearch = strSearch & ":"""
If InStr(1, strHTML, strSearch) = 0 Then parseGoog = "Not Found": Exit Function
parseGoog = Mid(strHTML, InStr(1, strHTML, strSearch) + Len(strSearch))
parseGoog = Mid(parseGoog, 1, InStr(1, parseGoog, """") - 1)
End Function

[Jacques25]

Since you have mentioned in your question that your requirement is that you have two addresses, in one you will input the destination and in another you want the output of miles and time taken. For distance & time separately you have to modify the function.

Public Function getGoogDistanceTime(rngSAdd As Range, rngEAdd As Range, Optional strReturn As String = "distance") As String
    Dim sURL As String
    Dim BodyTxt As String
    sURL = "http://maps.google.com/maps?f=d&source=s_d"
        sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
        sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
        sURL = sURL & "&hl=en"
    BodyTxt = getHTML(sURL)
    If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
        getGoogDistanceTime = "Error"
    Else
        getGoogDistanceTime = parseGoog(strReturn, BodyTxt)
    End If
End Function

After that the code:

A3: 
=GetGoogDistanceTime($A$1,$A$2,"time")

A4
=GetGoogDistanceTime($A$1,$A$2,"distance")

[Author]

To meet all your need precisely you have to do more approaches. For that you have to revise the user defined function further carefully. I have re-edited for you. You just have to copy paste the below vba in your coding. In the code my main aim was to format the cell containing the time returns to [h]:mm.

Public Function getGoogDistanceTime(rngSAdd As Range, rngEAdd As Range, Optional strReturn As String = "distance") As Variant
    Dim sURL As String
    Dim BodyTxt As String
    sURL = "http://maps.google.com/maps?f=d&source=s_d"
        sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
        sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
        sURL = sURL & "&hl=en"
    BodyTxt = getHTML(sURL)
    If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
        getGoogDistanceTime = "Error"
    Else
        getGoogDistanceTime = parseGoog(strReturn, BodyTxt)
        If LCase(strReturn) Like "time*" Then
            getGoogDistanceTime = Evaluate("""" & Replace(Replace(getGoogDistanceTime, " hours ", ":"), " mins", "") & ":0.0" & """+0")
        End If
    End If
End Function

[Dwarner]

Here is a modification, just the final part of the UDF which is very simple to understand also it is simple for you to implement it in your code.

If LCase(strReturn) Like "time*" Then
    getGoogDistanceTime = Evaluate("""" & Replace(Replace(getGoogDistanceTime, " hours ", ":"), " mins", "") & ":0.0" & """+0")
End If

--------------------------------------------------------------------------

If LCase(strReturn) Like "time*" Then
    getGoogDistanceTime = Evaluate("""" & Replace(Replace(getGoogDistanceTime, " hours ", ":"), " mins", "") & ":0.0" & """+0")
Else
    getGoogDistanceTime = Val(getGoogDistanceTime)
End If

[void]

According to me to retrieve data from Google map for miles as well as time you need an explicit option. If the above code does not help you then try this one. I am sure the below code won’t disappoint you. If the time is greater than minutes and less than hours e.g. 2 hr 23 min, the function will fail. This will solve the error of time and minutes.

Option Explicit
'
'Google Maps Driving Times
'
' ################################################################################
Sub test()
    MsgBox TgetGoogDistanceTime(Range("A2"), Range("B2"), "time")
    MsgBox VgetGoogDistanceTime(Range("A2"), Range("B2"), "time")
End Sub
' ################################################################################
'Separate distance and time - text output
'shred dude vbax
Public Function TgetGoogDistanceTime(rngSAdd As Range, rngEAdd As Range, Optional strReturn As String = "distance") As String
' =TGetGoogDistanceTime($A$1,$A$2,"time")
' coventry   manchester   2 hours 5 mins
' =TGetGoogDistanceTime($A$1,$A$2,"distance")
' coventry   manchester   116 mi
Dim sURL As String
Dim BodyTxt As String
sURL = "http://maps.google.com/maps?f=d&source=s_d"
sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
sURL = sURL & "&hl=en"
BodyTxt = getHTML(sURL)
If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
    TgetGoogDistanceTime = "Error"
Else
    TgetGoogDistanceTime = parseGoog(strReturn, BodyTxt)
End If
End Function
' ################################################################################
'Separate distance and time - not text
'shred dude vbax
Public Function VgetGoogDistanceTime( _
        rngSAdd As Range, _
        rngEAdd As Range, _
        Optional strReturn As String = "distance") _
            As Variant
' =VGetGoogDistanceTime($A$1,$A$2,"time")
' coventry   manchester   02:05
' =VGetGoogDistanceTime($A$1,$A$2,"distance")
' coventry   manchester   116
Dim sURL As String
Dim BodyTxt As String
sURL = "http://maps.google.com/maps?f=d&source=s_d"
sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
sURL = sURL & "&hl=en"
BodyTxt = getHTML(sURL)
If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
    VgetGoogDistanceTime = "Error"
Else
    VgetGoogDistanceTime = parseGoog(strReturn, BodyTxt)
    If LCase(strReturn) Like "time*" Then
        If InStr(1, VgetGoogDistanceTime, "hours", vbTextCompare) <> 0 Then
            VgetGoogDistanceTime = Evaluate("""" & Replace(Replace(VgetGoogDistanceTime, " hours ", ":"), " mins", "") & ":0.0" & """+0")
        Else
            VgetGoogDistanceTime = Evaluate("""" & Replace(Replace(VgetGoogDistanceTime, " hour ", ":"), " mins", "") & ":0.0" & """+0")
        End If
    Else
        VgetGoogDistanceTime = Val(VgetGoogDistanceTime)
    End If
End If
End Function
' ################################################################################
Public Function getHTML(strURL As String) As String
 'Returns the HTML code underlying a given URL
Dim oXH As Object
Set oXH = CreateObject("msxml2.xmlhttp")
With oXH
    .Open "get", strURL, False
    .Send
    getHTML = .responseText
End With
Set oXH = Nothing
End Function
' ################################################################################
Public Function parseGoog(strSearch As String, strHTML As String) As String
strSearch = strSearch & ":"""
If InStr(1, strHTML, strSearch) = 0 Then parseGoog = "Not Found": Exit Function
parseGoog = Mid(strHTML, InStr(1, strHTML, strSearch) + Len(strSearch))
parseGoog = Mid(parseGoog, 1, InStr(1, parseGoog, """") - 1)
End Function
' ################################################################################

[Kal-EL.Kanata]

Afternoon, I am trying to use this (and am not a regular VB user) and I am getting an error on the .send

Getting runtime error 8004005 when trying to run this section

The strURL works I have tested it but I always error out on the .SEND
' ################################################################################
Public Function getHTML(strURL As String) As String
'Returns the HTML code underlying a given URL
Dim oXH As Object
Set oXH = CreateObject("msxml2.xmlhttp")
With oXH
.Open "get", strURL, False
.Send
getHTML = .responseText
End With
Set oXH = Nothing
End Function
################################################################################

My assumption is I use A2 and B2 on the worksheet for the 2 cities and the script does the rest and creates and output, please correct me if I am wrong.


Thanks in advance for any help