Solved: Total distance and time between two cities in a state

**Kenneth Hobs** · 12-30-2011, 09:34 AM

That is what we get for getting older, things start breaking and falling apart...

The xml output from the API has multiple roots so it does not lend itself well to standard xml parsing methods. I guess we could look at the json output but then we would probably just use our standard text parsing methods that are prone to failing again.

I noticed that the return results are just a bit different now, for:
10008 Falls Road Potomac MD 40854 500 EL Camino Real Santa Clara CA 95053.

It was 2,833 mi / 1 day 21 hours but is now 2,830 mi / 1 day 22 hours.

[vba]' Google API code directions:
' http://code.google.com/apis/maps/doc...on/directions/

'=GoogleDistanceTime(A4,B4,C4,D4,E4,F4,G4,H4)
Public Function GoogleDistanceTime(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 xml As String, sDistance As String, sDuration As String
Dim sURL As String
Dim s As String, _
d As String, _
t As String

'http://maps.googleapis.com/maps/api/directions/xml?origin=Chicago,IL&destination=Los+Angeles,CA&waypoints=Joplin,MO|Oklaho ma+City,OK&sensor=false
sURL = "http://maps.googleapis.com/maps/api/directions/xml?origin="
sURL = sURL & Replace(startAddr, " ", "+") & ",+" & Replace(StartCity, " ", "+") & ",+" & startState
sURL = sURL & "&destination=" & Replace(endAddr, " ", "+") & ",+" & Replace(EndCity, " ", "+") & ",+" & endState
sURL = sURL & "&sensor=false"

Application.Volatile False

xml = getXML(sURL)
sDistance = pGoog("distance", xml)
sDuration = pGoog("duration", xml)
GoogleDistanceTime = sDistance & " / " & sDuration
End Function

Private Function getXML(strURL As String) As String
Dim HTTPreq As Object
Dim BodyTxt As String

'Set HTTPreq = CreateObject("msxml2.xmlhttp")
Set HTTPreq = CreateObject("WinHttp.WinHttpRequest.5.1")
With HTTPreq
.Open "GET", strURL, False
.send
.WaitForResponse
BodyTxt = .responseText
End With
Set HTTPreq = Nothing
getXML = BodyTxt
End Function

Private Function pGoog(strSearch As String, strHTML As String) As String
Dim s As String
s = pRevTags(strSearch, strHTML)
pGoog = pRevTags("text", s)
End Function

Private Function pRevTags(strSearch As String, strHTML As String) As String
Dim s As String, p1 As Long, p2 As Long, lss As Integer
p1 = InStrRev(strHTML, "<" & strSearch & ">")
If p1 = 0 Then
pRevTags = "Not Found"
Exit Function
End If
p2 = InStrRev(strHTML, "</" & strSearch & ">")
lss = Len(strSearch)
s = Mid(strHTML, p1 + lss + 2, p2 - p1 - 2 - lss)
pRevTags = s
End Function
[/vba]

**developresou** · 12-30-2011, 11:54 PM

VERY USEFUL!

**vishwakarma** · 03-01-2012, 10:00 AM

Hi Guys,

My UDF is not working.. can someone please send me a file containing the UDF in working condition...

Many Thanks,

**Kenneth Hobs** · 03-01-2012, 11:13 AM

My code works fine. In your last file's L2:

=GoogleDistanceTime(A2,B2,C2,D2,E2,F2,G2,H2)

**vishwakarma** · 03-19-2012, 11:34 AM

Thanks Kenneth,

But it still not working, giving me Value error...

Thanks,

**Kenneth Hobs** · 03-19-2012, 12:14 PM

If you use your code, then I am not surprised. If you used mine, I would be surprised. Post a simple workbook with my code if you want me to check it out.