使用 VBA 方法通过 Bing API 获取距离
Get distance via Bing API using VBA method
我正在尝试通过 VBA 创建一个方法,当我使用此方法时它显示#NAME?有时#value.
Public Function DISTANCE(start As String, dest As String, key As String)
Dim firstVal As String, secondVal As String, lastVal As String
firstVal = "http://dev.virtualearth.net/REST/V1/Routes/Driving?wp.0="
secondVal = "&wp.1=destinations="
lastVal = "&optimize=time&routePathOutput=Points&distanceUnit=km&output=xml&key=" & key
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & start & secondVal & dest & lastVal
objHTTP.Open "GET", URL, False
objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.Send ("")
DISTANCE = Round(Round(WorksheetFunction.FilterXML(objHTTP.ResponseText, "//TravelDistance"), 3) * 1.609, 0)
End Function
三件事。
您需要以小写形式传递往返位置以及州的 2 个字母缩写
以上需要urlencode
响应具有您需要添加的默认命名空间。对于后者,我求助于使用 MSXML2.DOMDocument 以便能够添加命名空间。
Public Sub test()
Debug.Print GetDistance("new york,ny", "miami,fl", "key")
End Sub
Public Function GetDistance(ByVal start As String, ByVal dest As String, ByVal key As String) As Long
Dim firstVal As String, secondVal As String, lastVal As String, objHTTP As Object, url As String
firstVal = "http://dev.virtualearth.net/REST/V1/Routes/Driving?wp.0="
secondVal = "&wp.1=destinations="
lastVal = "&optmz=time&routePathOutput=Points&distanceUnit=km&output=xml&key=" & key
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
url = firstVal & Application.EncodeURL(LCase$(start)) & secondVal & Application.EncodeURL(LCase$(dest)) & lastVal
objHTTP.Open "GET", url, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send
Dim xmlDoc As MSXML2.DOMDocument60 'reference to Microsoft XML via VBE>Tools>References
Set xmlDoc = New MSXML2.DOMDocument60
xmlDoc.LoadXML objHTTP.responseText
xmlDoc.SetProperty "SelectionNamespaces", "xmlns:r='http://schemas.microsoft.com/search/local/ws/rest/v1'"
GetDistance = Round(Round(xmlDoc.SelectSingleNode("//r:TravelDistance").Text, 3) * 1.609, 0)
End Function
我正在尝试通过 VBA 创建一个方法,当我使用此方法时它显示#NAME?有时#value.
Public Function DISTANCE(start As String, dest As String, key As String)
Dim firstVal As String, secondVal As String, lastVal As String
firstVal = "http://dev.virtualearth.net/REST/V1/Routes/Driving?wp.0="
secondVal = "&wp.1=destinations="
lastVal = "&optimize=time&routePathOutput=Points&distanceUnit=km&output=xml&key=" & key
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & start & secondVal & dest & lastVal
objHTTP.Open "GET", URL, False
objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.Send ("")
DISTANCE = Round(Round(WorksheetFunction.FilterXML(objHTTP.ResponseText, "//TravelDistance"), 3) * 1.609, 0)
End Function
三件事。
您需要以小写形式传递往返位置以及州的 2 个字母缩写
以上需要urlencode
响应具有您需要添加的默认命名空间。对于后者,我求助于使用 MSXML2.DOMDocument 以便能够添加命名空间。
Public Sub test()
Debug.Print GetDistance("new york,ny", "miami,fl", "key")
End Sub
Public Function GetDistance(ByVal start As String, ByVal dest As String, ByVal key As String) As Long
Dim firstVal As String, secondVal As String, lastVal As String, objHTTP As Object, url As String
firstVal = "http://dev.virtualearth.net/REST/V1/Routes/Driving?wp.0="
secondVal = "&wp.1=destinations="
lastVal = "&optmz=time&routePathOutput=Points&distanceUnit=km&output=xml&key=" & key
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
url = firstVal & Application.EncodeURL(LCase$(start)) & secondVal & Application.EncodeURL(LCase$(dest)) & lastVal
objHTTP.Open "GET", url, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send
Dim xmlDoc As MSXML2.DOMDocument60 'reference to Microsoft XML via VBE>Tools>References
Set xmlDoc = New MSXML2.DOMDocument60
xmlDoc.LoadXML objHTTP.responseText
xmlDoc.SetProperty "SelectionNamespaces", "xmlns:r='http://schemas.microsoft.com/search/local/ws/rest/v1'"
GetDistance = Round(Round(xmlDoc.SelectSingleNode("//r:TravelDistance").Text, 3) * 1.609, 0)
End Function