Google Maps Driving Times

hey thegooser123

found this by Shred Dude at VbaX

'shred dude vbax
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

hope it helps

Given you wish to return distance & time separately you would need to modify the first function slightly, eg:

'shred dude vbax
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

then

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

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

The functions must all reside in a standard module in VBE (Insert > Module) - when re-opening the file ensure macros are enabled.

A few approaches - one would be to revise the UDF further:

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

formatting cells containing the time returns to [h]:mm

perhaps simplest (at this time of night!) to just modify the final part of the UDF such that instead of:

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

you have

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

Your post does not comply with Rule 2 of our Forum RULES. Don't post a question in the thread of another member -- start your own thread. If you feel it's particularly relevant, provide a link to the other thread.

Actually, the #VALUE! error may be due to the time rather than the cells not found.

If the time is greater than minutes and less than hours, for example, 1 hour 18 mins, the function will fail.

I modified it to cope with hours and hour in the return.

I have two versions of the function now; one that returns the text values and one that returns the numeric values for time and distance.

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
' ################################################################################

thanks to the originator of the functions and DonkeyOte for modifying it to cater for input from cells.


Regards

good spot TMS though you could just embed a further Replace

getGoogDistanceTime = Evaluate("""" & Replace(Replace(Replace(getGoogDistanceTime, " hours ", " hour "), " hour ", ":"), " mins", "") & ":0.0" & """+0")

I have saved my version accordingly.

edit: should note it would still fail for minute distances but I would live with that as it would flag oversights.

@DonkeyOte: hah, you make it look so easy :-)

I tried all sorts to overcome the problem when I realised what it was and I really, really struggled. eventually, I came up with an answer ... but I prefer yours, much neater.

Regards

A more robust version might be:

Public Function getGoogDistanceTime(rngSAdd As Range, rngEAdd As Range, Optional strReturn As String = "distance") As Variant
    Dim sURL As String
    Dim BodyTxt As String
    Dim vUnits As Variant
    Dim lngDiv As Long
    Dim dblTemp As Double
    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
            vUnits = Split(getGoogDistanceTime)
            For bUnit = LBound(vUnits) To UBound(vUnits) - 1 Step 2
                dblTemp = dblTemp + _
                        Val(vUnits(bUnit)) / Choose(InStr(1, "hms", Left(vUnits(bUnit + 1), 1), vbTextCompare), 24, 1440, 86400)
            Next bUnit
            getGoogDistanceTime = dblTemp
        Else
            getGoogDistanceTime = Val(getGoogDistanceTime)
        End If
    End If
End Function

that should handle hour(s), min(s) & sec(s) and combinations thereof.

It does seem to have stopped working. I'm guessing the HTML that is being returned has changed so the function to find the time/distance is no longer able to find the value.

Dom

I have to be honest and say I haven't touched this since the last dialogue.

Sadly, it seems that something has changed. I'm getting #VALUE! for parameters that previously worked and returned distances and time.

Regards

It shouldn't be too hard to adjust the code to pick up the info again. Will have a look later if I get a chance and nobody else has.

Dom

Made a couple of changes to this function that's called which seems to make it work now:

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
    Else
        parseGoog = Mid(strHTML, InStr(1, strHTML, strSearch) + Len(strSearch))
        parseGoog = Mid(parseGoog, 1, InStr(1, parseGoog, "'") - 1)
    End If
End Function

Dom

What did it used to return for them? I never tried it to be honest.

Dom

I meant what sort of value did it used to return? Time in hours/mins/seconds?

Dom

Hello,
Did anyone tried the above code on excel 2010. I keep on getting #Value!. This is what i did..
Copied the code in a new module and saved the file as *.xlsm extention.
Please help...

A1=Turin, Italy
A2=Milan, Italy
--------------------------
A3=#VALUE!

Formulae: getGoogDistanceTime($A$1:$A$2;"distance")

Actually, i'm only interested in the KM calculation part

Many Thanks,
Ravi

Try a semicolon between A1 and A2 instead of a colon. Does that work?

Works fine in 2007. Can't see it being different in 2010.


=getGoogDistanceTime($A2,$B2,C$1) .... C$1 has "distance" in it. Note that distance and time text values are case sensitive.


Try just Turin and Milan

HTML Code: 

Regards

You're welcome. Thanks for the rep.

It is pretty cool! I tried to come up with something similar a while back but failed miserably so learnt some new stuff figuring out the problem when it occurred.

Dom

Welcome to the Forum, unfortunately:

Your post does not comply with Rule 2 of our Forum RULES. Don't post a question in the thread of another member -- start your own thread. If you feel it's particularly relevant, provide a link to the other thread. It makes sense to have a new thread for your question because a thread with numerous replies can be off putting & difficult to pick out relevant replies.