我的问题集中在使用批处理请求来解决与其他许多邮政编码相关的单个邮政编码之间的距离,使用Microsoft Access数据库中的Microsoft Bing Maps API。
我在数据库中有两个表I_BasePostcode
和I_Postcodes
。 I_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分钟,我想知道是否有一种方法可以批量处理以提高效率?