Go Back   TechArena Community > Software > Windows Software
Become a Member!
Forgot your username/password?
Register Tags Active Topics RSS Search Mark Forums Read

Sponsored Links



Driving Times and miles from Google Maps.

Windows Software


Reply
 
Thread Tools Search this Thread
  #1  
Old 13-07-2011
Member
 
Join Date: Jun 2011
Posts: 84
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

Reply With Quote
  #2  
Old 13-07-2011
Member
 
Join Date: May 2009
Posts: 503
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
Reply With Quote
  #3  
Old 13-07-2011
Member
 
Join Date: May 2009
Posts: 532
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")
Reply With Quote
  #4  
Old 13-07-2011
Member
 
Join Date: May 2009
Posts: 523
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
Reply With Quote
  #5  
Old 13-07-2011
Member
 
Join Date: Apr 2009
Posts: 567
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
Reply With Quote
  #6  
Old 15-07-2011
Member
 
Join Date: Nov 2008
Posts: 1,192
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
' ################################################################################
Reply With Quote
  #7  
Old 15-11-2011
Member
 
Join Date: Nov 2011
Posts: 1
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
Reply With Quote
Reply

  TechArena Community > Software > Windows Software
Tags: , , , ,



Thread Tools Search this Thread
Search this Thread:

Advanced Search


Similar Threads for: "Driving Times and miles from Google Maps."
Thread Thread Starter Forum Replies Last Post
Is there any portable version of Google Earth or Google Maps Calverta Technology & Internet 5 05-07-2012 10:38 AM
Google lower prices for Google Maps API and continuous support on iOS jackalz Web News & Trends 1 25-06-2012 12:50 PM
Google Tracks Santa Around The World Through Google Earth, Google Maps, Google Maps for Mobile And iGoogle absolute55 Off Topic Chat 4 13-08-2010 09:02 AM
Saving Maps with Google Maps ABDIEL Technology & Internet 3 16-10-2009 06:37 PM


All times are GMT +5.5. The time now is 05:34 AM.