从Microsoft Access中批量请求Bing Maps Route API

时间:2015-12-23 11:49:21

标签: vba ms-access access-vba bing-maps

我的问题集中在使用批处理请求来解决与其他许多邮政编码相关的单个邮政编码之间的距离,使用Microsoft Access数据库中的Microsoft Bing Maps API。

我在数据库中有两个表I_BasePostcodeI_PostcodesI_BasePostcode为感兴趣的点(在这种情况下为医院)保留一个邮政编码,I_Postcodes包含数千(最多30,000)个其他邮政编码以及它们各自与{{1}的距离}}

I_BasePostcode看起来像:

I_BasePostcode

来自+----------+ | Postcode | +----------+ | LS1 3EX | +----------+ 表的摘录如下:

I_Postcodes

使这成为可能的VBA代码是:

+----------+--------------------+
| Postcode | DistanceFromBase   |
+----------+--------------------+
| SW13 9EE |                200 |
| SW13 9EF |                201 |
| SW13 9EP |                205 |
+----------+--------------------+

请注意我有一些解析JSON输出的附加模块,这些模块不属于我的问题范围,我没有包含它们。

最后,我用来将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 中的邮政编码与Microsoft Bing匹配的查询是:

I_Postcodes

虽然我的查询有效,但解析9,000个邮政编码需要大约50分钟,我想知道是否有一种方法可以批量处理以提高效率?

0 个答案:

没有答案