Driving Times and miles from Google Maps.
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
Re: Driving Times and miles from Google Maps.
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.
Code:
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
Re: Driving Times and miles from Google Maps.
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.
Code:
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:
Code:
A3:
=GetGoogDistanceTime($A$1,$A$2,"time")
A4
=GetGoogDistanceTime($A$1,$A$2,"distance")
Re: Driving Times and miles from Google Maps.
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.
Code:
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
Re: Driving Times and miles from Google Maps.
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.
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
Re: Driving Times and miles from Google Maps.
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.
Code:
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
' ################################################################################
Re: Driving Times and miles from Google Maps.
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