Results 1 to 7 of 7

Thread: Driving Times and miles from Google Maps.

  1. #1
    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

  2. #2
    Join Date
    May 2009
    Posts
    513

    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

  3. #3
    Join Date
    May 2009
    Posts
    546

    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")

  4. #4
    Join Date
    May 2009
    Posts
    529

    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

  5. #5
    Join Date
    Apr 2009
    Posts
    570

    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

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

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

Similar Threads

  1. Is there any portable version of Google Earth or Google Maps
    By Calverta in forum Technology & Internet
    Replies: 5
    Last Post: 05-07-2012, 10:38 AM
  2. Replies: 1
    Last Post: 25-06-2012, 12:50 PM
  3. Replies: 4
    Last Post: 13-08-2010, 09:02 AM
  4. Saving Maps with Google Maps
    By ABDIEL in forum Technology & Internet
    Replies: 3
    Last Post: 16-10-2009, 06:37 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •