我找到了一个代码，可帮助我在使用Excel电子表格时，从Google地图导出两个地点的旅行时间和距离。
它工作正常，但我遗漏的一件事是增加一个中间点的机会。你认为修改代码是可行的，所以我可以在第3个单元格中间点吗？
请在下面找到代码：
' 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
谢谢你， Przemek