Пакетный запрос 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 минут, и мне интересно, есть ли способ, которым это можно сделать, чтобы повысить эффективность?

0 ответов

Другие вопросы по тегам