Пакетный запрос Bing Maps Route API из Microsoft Access
Мой вопрос касается использования пакетного запроса для определения расстояния между одним почтовым индексом по отношению ко многим другим с использованием API Bing Maps Microsoft в базе данных Microsoft Access.
У меня есть две таблицы в базе данных, I_BasePostcode
а также I_Postcodes
, I_BasePostcode
содержит один почтовый индекс для точки интереса (больница в данном случае) и I_Postcodes
хранить тысячи (до 30000) других почтовых индексов, а также их соответствующие расстояния от I_BasePostcode
,
I_BasePostcode
похоже:
+----------+
| Postcode |
+----------+
| LS1 3EX |
+----------+
и выписка из I_Postcodes
Стол выглядит так:
+----------+--------------------+
| Postcode | DistanceFromBase |
+----------+--------------------+
| SW13 9EE | 200 |
| SW13 9EF | 201 |
| SW13 9EP | 205 |
+----------+--------------------+
Код VBA, который делает это возможным:
Const BASEURL As String = "http://dev.virtualearth.net/REST/V1/Routes/Driving"
Const BINGKEY As String = "It's a secret"
Public Function GetDistance(FirstLocation As String, SecondLocation As String)
Dim JSON As Object
Dim EditedLocation As String
' Parse the JSON output
Set JSON = JsonConverter.ParseJson(HttpRequestToBing(FirstLocation, SecondLocation))
' If we get an error on the first pass it's because of Bing not liking 8 digit postcodes
If JSON("statusCode") <> 200 Then
If Len(SecondLocation) = 8 Then
EditedLocation = Left(SecondLocation, 4)
Set JSON = JsonConverter.ParseJson(HttpRequestToBing(FirstLocation, EditedLocation))
End If
If Len(SecondLocation) = 7 Then
EditedLocation = Left(SecondLocation, 3)
Set JSON = JsonConverter.ParseJson(HttpRequestToBing(FirstLocation, EditedLocation))
End If
End If
' Catch any errors from the second pass
If JSON("statusCode") <> 200 Then GoTo ErrorHandl
' Nasty Bing JSON formatting makes accessing the distance difficult
GetDistance = Trim(JSON("resourceSets")(1)("resources")(1)("travelDistance"))
Exit Function
ErrorHandl:
GetDistance = ""
End Function
Function HttpRequestToBing(FirstLocation As String, SecondLocation As String)
Dim BingURL As String
Dim http As Object
' Setup the Map URL
BingURL = BASEURL & "?wp.0=" & URLEncode(FirstLocation) & "&wp.1=" & URLEncode(SecondLocation) & "&avoid=minimizeTolls&du=mi&key=" & BINGKEY
' Setup the request and authorization
Set http = CreateObject("MSXML2.ServerXMLHTTP")
http.Open "GET", BingURL, False
http.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
http.send
HttpRequestToBing = http.responseText
End Function
Обратите внимание, что у меня есть несколько дополнительных модулей, которые анализируют вывод JSON, которые не входят в объем моего вопроса, и я их не включал.
Наконец, запрос, который я использую, чтобы соответствовать почтовым индексам в I_Postcodes
для Microsoft Bing это:
UPDATE I_Postcodes, I_BasePostcode
SET I_Postcodes.DistanceFromBase = GetDistance([I_BasePostcode].[Postcode],[I_Postcodes].[Postcode])
WHERE (((I_Postcodes.DistanceFromBase) Is Null));
Хотя мой запрос работает, для анализа 9000 почтовых индексов требуется около 50 минут, и мне интересно, есть ли способ, которым это можно сделать, чтобы повысить эффективность?