XL: ping mapquest or googlemaps to get driving time + distance?

[ker_01]

Has anyone used Excel to post addresses to any mapping website and scrape the
resulting driving distance (milage) and travel time? I'm not worried about
the actual directions, just getting these two numbers. I have a spreadsheet
with several thousand 'To:' and 'From:' addresses, and want to be able to
cycle through them without doing it via cut/paste.

I appreciate any existing code snippets you'd be willing to share!

Thank you,
Keith

 

[JP]

I have some sample code here you can adapt:

http://www.codeforexcelandoutlook.com/excel-vba/latitude-longitude-functions/

--JP

 

[ker_01]

Excellent, thank you- very easily adapted to give both time and distance.
Best,
Keith

 

[Paige]

Hi, JP. I can't seem to get this to work; have set all my references.
However, it will pull up Mapquest, insert the addresses and bring up the
map/info, but it stops there and doesn't return the result to the cell or
continue on. I don't get any error messages; it just stops. Do you have any
idea of what I'm doing wrong; I didn't change any code and have my start/end
addresses all in Row 1, starting with Col A?

 

[ker_01]

Paige-

I had to change the search string in two places in the code (the text string
it searches for on the Mapquest page has changed to "Total Travel
Estimates:"). I expanded the length of the returned string and usedtext
string commands (Instr, Left, Right, Trim, etc) to grab the parts.

With regex
.Pattern = "Total Travel Estimates:"
.MultiLine = False
End With

and

If Regmatch.Count > 0 Then
GetFirstPos = WorksheetFunction.Find("Total Travel Estimates:", BodyTxt,
1)
GetDistance1 = Mid(BodyTxt, GetFirstPos + 23, 100)
GetDistance2 = Trim(Left(GetDistance1, InStr(GetDistance1, "Fuel Cost:")
- 1))
GetMiles = Trim(Right(GetDistance2, Len(GetDistance2) -
InStr(GetDistance2, "/")))
GetMiles2 = Val(Trim(Left(GetMiles, InStr(GetMiles, "miles") - 1)))
GetTT = Trim(Left(GetDistance2, InStr(GetDistance2, "/") - 1))
DoEvents
GetDistance = GetMiles2
Else
GetDistance = "Address Error, fix and try again"
End If

So far, I'm just pulling milage and not the travel time, but it's there if
you need it.

If you still have problems, probably best to post your entire sub with all
edits, and indicate which line the code is stopping on.

Best,
Keith

 

[Paige]

Thanks; I'll have to work with this a bit to make sure I don't mess any of it
up!

 

[aldiani]

Hi,

First off, thanks for posting this script and modifications. As
novice VBA scripter, they've been a huge help, without which I'd b
completely lost.

I've run into a wierd issue that I was hoping to get some help on
Unless I add a message box as highlighted below, the function return
#VALUE. Does anyone know why this may be, or hopefully, how to fix it
I'd like to be able to run the function without having to manually clic
the message box okay botton.

Thanks again,
Sam


Code
-------------------
' must set references to Microsoft VBScript Regular Expressions, Internet Controls
' & HTML Object Library before running this script
' based on http://www.vbaexpress.com/kb/getarticle.php?kb_id=386
Public Function GetDistance(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 appIE As InternetExplorer
Dim regex As RegExp, Regmatch As MatchCollection
Dim BodyTxt As String
Dim GetFirstPos As Long

sURL = "http://www.mapquest.com/maps?1c=" & Replace(startCity, " ", "+")
sURL = sURL & "&1s=" & startState & "&1a=" & Replace(startAddr, " ", "+")
sURL = sURL & "&1z=" & startZip & "&2c=" & endCity & "&2s=" & endState
sURL = sURL & "&2a=" & Replace(endAddr, " ", "+") & "&2z=" & endZip

Set appIE = New InternetExplorer
'Set appIE = CreateObject("Internetexplorer.application")

appIE.navigate sURL
appIE.Visible = True

Do
DoEvents

Loop Until appIE.readyState = READYSTATE_COMPLETE

appIE.Refresh

Set regex = New RegExp
With regex
.Pattern = "Total Travel Estimates:"
.MultiLine = False
End With

MsgBox "Loaded VBAX link"


BodyTxt = appIE.Document.body.innerText
Set Regmatch = regex.Execute(BodyTxt)

If Regmatch.Count > 0 Then
GetFirstPos = WorksheetFunction.Find("Total Travel Estimates:", BodyTxt, 1)
GetDistance1 = Mid(BodyTxt, GetFirstPos + 23, 100)
GetDistance2 = Trim(Left(GetDistance1, InStr(GetDistance1, "Fuel Cost:") - 1))
GetMiles = Trim(Right(GetDistance2, Len(GetDistance2) - InStr(GetDistance2, "/")))
GetMiles2 = Val(Trim(Left(GetMiles, InStr(GetMiles, "miles") - 1)))
GetTT = Trim(Left(GetDistance2, InStr(GetDistance2, "/") - 1))
DoEvents
GetDistance = GetTT
Else
GetDistance = "Address Error, fix and try again"
End If

appIE.Quit
Set appIE = Nothing
Set regex = Nothing
Set Regmatch = Nothing

End Functio
-------------------

Thanks; I'll have to work with this a bit to make sure I don't mess an
of it
up!

Paige-

I had to change the search string in two places in the code (the tex string
it searches for on the Mapquest page has changed to "Total Travel
Estimates:"). I expanded the length of the returned string an usedtext
string commands (Instr, Left, Right, Trim, etc) to grab the parts.

With regex
.Pattern = "Total Travel Estimates:"
.MultiLine = False
End With

and

If Regmatch.Count > 0 Then
GetFirstPos = WorksheetFunction.Find("Total Travel Estimates:" BodyTxt,
1)
GetDistance1 = Mid(BodyTxt, GetFirstPos + 23, 100)
GetDistance2 = Trim(Left(GetDistance1, InStr(GetDistance1, "Fue Cost:")
- 1))
GetMiles = Trim(Right(GetDistance2, Len(GetDistance2) -
InStr(GetDistance2, "/")))
GetMiles2 = Val(Trim(Left(GetMiles, InStr(GetMiles, "miles") 1)))
GetTT = Trim(Left(GetDistance2, InStr(GetDistance2, "/") - 1))
DoEvents
GetDistance = GetMiles2
Else
GetDistance = "Address Error, fix and try again"
End If

So far, I'm just pulling milage and not the travel time, but it' there if
you need it.

If you still have problems, probably best to post your entire su with all
edits, and indicate which line the code is stopping on.

Best,
Keith