Connecting Excel spreadsheet with Google maps while using VBA - vba

Question

I have found a code on which helps me export both travel time and a distance between 2 locations from Google Maps, while using Excel spreadsheet.
It works fine, but one thing I am missing is an opportunity to add an in-between point. Do you think it is doable to modify the code so I could have 3th cell with in-between point?
Please find code below:
' Usage :
' GetGoogleTravelTime (strFrom, strTo) returns a string containing journey duration : hh:mm
' GetGoogleDistance (strFrom, strTo) returns a string containing journey distance in either miles or km (as defined by strUnits)
' GetGoogleDirections (strFrom, strTo) returns a string containing the directions
'
' where strFrom/To are address search terms recognisable by Google
' i.e. Postcode, address etc.
'
' by Desmond Oshiwambo
Const strUnits = "metric" ' imperial/metric (miles/km)
Function CleanHTML(ByVal strHTML)
'Helper function to clean HTML instructions
Dim strInstrArr1() As String
Dim strInstrArr2() As String
Dim s As Integer
strInstrArr1 = Split(strHTML, "<")
For s = LBound(strInstrArr1) To UBound(strInstrArr1)
strInstrArr2 = Split(strInstrArr1(s), ">")
If UBound(strInstrArr2) > 0 Then
strInstrArr1(s) = strInstrArr2(1)
Else
strInstrArr1(s) = strInstrArr2(0)
End If
Next
CleanHTML = Join(strInstrArr1)
End Function
Public Function formatGoogleTime(ByVal lngSeconds As Double)
'Helper function. Google returns the time in seconds, so this converts it into time format hh:mm
Dim lngMinutes As Long
Dim lngHours As Long
lngMinutes = Fix(lngSeconds / 60)
lngHours = Fix(lngMinutes / 60)
lngMinutes = lngMinutes - (lngHours * 60)
formatGoogleTime = Format(lngHours, "00") & ":" & Format(lngMinutes, "00")
End Function
Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = "") As Boolean
On Error GoTo errorHandler
' Helper function to request and process XML generated by Google Maps.
Dim strURL As String
Dim objXMLHttp As Object
Dim objDOMDocument As Object
Dim nodeRoute As Object
Dim lngDistance As Long
Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objDOMDocument = CreateObject("MSXML2.DOMDocument.6.0")
strStartLocation = Replace(strStartLocation, " ", "+")
strEndLocation = Replace(strEndLocation, " ", "+")
strURL = "http://maps.googleapis.com/maps/api/directions/xml" & _
"?origin=" & strStartLocation & _
"&destination=" & strEndLocation & _
"&sensor=false" & _
"&units=" & strUnits 'Sensor field is required by google and indicates whether a Geo-sensor is being used by the device making the request
'Send XML request
With objXMLHttp
.Open "GET", strURL, False
.setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
.Send
objDOMDocument.LoadXML .ResponseText
End With
With objDOMDocument
If .SelectSingleNode("//status").Text = "OK" Then
'Get Distance
lngDistance = .SelectSingleNode("/DirectionsResponse/route/leg/distance/value").Text ' Retrieves distance in meters
Select Case strUnits
Case "imperial": strDistance = Round(lngDistance * 0.00062137, 1) 'Convert meters to miles
Case "metric": strDistance = Round(lngDistance / 1000, 1) 'Convert meters to miles
End Select
'Get Travel Time
strTravelTime = .SelectSingleNode("/DirectionsResponse/route/leg/duration/value").Text 'returns in seconds from google
strTravelTime = formatGoogleTime(strTravelTime) 'converts seconds to hh:mm
'Get Directions
For Each nodeRoute In .SelectSingleNode("//route/leg").ChildNodes
If nodeRoute.BaseName = "step" Then
strInstructions = strInstructions & nodeRoute.SelectSingleNode("html_instructions").Text & " - " & nodeRoute.SelectSingleNode("distance/text").Text & vbCrLf
End If
Next
strInstructions = CleanHTML(strInstructions) 'Removes MetaTag information from HTML result to convert to plain text.
Else
strError = .SelectSingleNode("//status").Text
GoTo errorHandler
End If
End With
gglDirectionsResponse = True
GoTo CleanExit
errorHandler:
If strError = "" Then strError = Err.Description
strDistance = -1
strTravelTime = "00:00"
strInstructions = ""
gglDirectionsResponse = False
CleanExit:
Set objDOMDocument = Nothing
Set objXMLHttp = Nothing
End Function
Function getGoogleTravelTime(ByVal strFrom, ByVal strTo) As String
'Returns the journey time between strFrom and strTo
Dim strTravelTime As String
Dim strDistance As String
Dim strInstructions As String
Dim strError As String
If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
getGoogleTravelTime = strTravelTime
Else
getGoogleTravelTime = strError
End If
End Function
Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String
'Returns the distance between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.
Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String
If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
getGoogleDistance = strDistance
Else
getGoogleDistance = strError
End If
End Function
Function getGoogleDirections(ByVal strFrom, ByVal strTo) As String
'Returns the directions between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.
Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String
If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
getGoogleDirections = strInstructions
Else
getGoogleDirections = strError
End If
End Function
Thank you,
Przemek