Select to view content in your preferred language

Using Address Locator in an MS Access database

852
1
Jump to solution
02-07-2018 12:29 PM
BrianBulla
Honored Contributor

Hi,

I'm trying to figure out the best way to use an existing Locator service within an MS Access database for verifying that the address being typed in is actually valid.  Within my MS Access database I can retrieve the 'score' from the locator service using some code like this:

Private Sub Command0_Click()
    Dim httpReq As New MSXML2.ServerXMLHTTP
    httpReq.Open "GET", "https://maps.durham.ca/arcgis/rest/services/Locators/Durham_Locator/GeocodeServer/findAddressCandida... Church Street, Ajax&outfields=Score&f=json"

    httpReq.send
    Dim response As String
    response = httpReq.responseText
        
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set thefile = fs.CreateTextFile(Application.CurrentProject.Path & "\geo.txt", True)
    thefile.write (response)
    thefile.Close
       
    'MsgBox response
    'MsgBox Application.CurrentProject.Path
    
    
End Sub

Has anyone done this before?  I'm not totally sure of the best approach from here.  I guess I could scan the response to look for the score of all the matches, and let the user choose the best one??

I guess I'm just looking for some ideas.  The formatting of the JSON that comes back is a bit foreign to me and I'm not

sure of the best way to deal with it.

Here is a sample of what I am getting back from the service:

{"spatialReference":{"wkid":26917,"latestWkid":26917},"candidates":[{"address":"66 Church Street North, Ajax","location":{"x":656188.74132460123,"y":4857786.8273707693},"score":90.870000000000005,"attributes":{"Score":90.870000000000005}},{"address":"66 Church Street South, Ajax","location":{"x":656363.87805667717,"y":4857321.912464018},"score":90.870000000000005,"attributes":{"Score":90.870000000000005}},{"address":"66 Church St S, Ajax","location":{"x":656335.19874352403,"y":4857300.3138142293},"score":90.870000000000005,"attributes":{"Score":90.870000000000005}},{"address":"66 Church St S, Ajax","location":{"x":656337.24088169797,"y":4857318.2643990703},"score":90.870000000000005,"attributes":{"Score":90.870000000000005}}]}

Or is there a totally different, better way that what I am thinking??

Thanks for any input!!

Tags (2)
0 Kudos
1 Solution

Accepted Solutions
BrianBulla
Honored Contributor

I have found a solution that works pretty good.  For anyone who is interested:

Here is a link to a JSON parser built speficially for VBA:  GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA 

Using my code above, I tweaked it a bit to come up with this, which is working fairly well so far.  Probably some adjustments to come, but so far, so good.

Private Sub Command0_Click()
    Dim httpReq As New MSXML2.ServerXMLHTTP
    
    Dim fullAddress As String
    
    fullAddress = txtNumber & " " & txtStreetName & " " & txtType & " " & txtDir & ", " & cboMunicipality
    
    httpReq.Open "GET", "https://maps.durham.ca/arcgis/rest/services/Locators/ADDR_Locator/GeocodeServer/findAddressCandidate... Line Input=" & fullAddress & "&outfields=Score&f=json"

    httpReq.send
    Dim response As String
    response = httpReq.responseText
    
    Dim json As Object
    Set json = JsonConverter.ParseJson(response)
    
    Dim foundMatch As Boolean
    Dim alternateAddress As Variant
    Dim dimEd As Boolean
    
    dimEd = False
       
    On Error GoTo JSON_Handler:
    For i = 1 To 5
        If json("candidates")(i)("score") = 100 Then
            foundMatch = True
            MsgBox fullAddress & " is a valid address.", vbInformation, "Match Found"
            Exit Sub
        Else
            If dimEd = True Then
                ReDim Preserve alternateAddress(0 To UBound(alternateAddress) + 1) As String
            Else
                ReDim alternateAddress(0 To 0) As String
                dimEd = True
            End If
            
            alternateAddress(UBound(alternateAddress)) = json("candidates")(i)("address") & " - Score =  " & Round(json("candidates")(i)("score"), 2) & "%"
        End If
        
    Next i
    
JSON_Handler:
    If IsEmpty(alternateAddress) Then
        MsgBox "Provided address does not exist in our corporate address list.  There are no similar matching addresses.", vbInformation, "Address Not Valid"
        Exit Sub
    End If
    
    For i = 0 To UBound(alternateAddress)
        Dim list As String
        list = list & alternateAddress(i) & vbCr & vbCr
    Next i
    
    MsgBox "Provided address does not exist in our corporate address list.  Here are some similar addresses:" & vbCr & vbCr & list, vbInformation, "Alternate Addresses and Geocode Score"
    
    End Sub

View solution in original post

0 Kudos
1 Reply
BrianBulla
Honored Contributor

I have found a solution that works pretty good.  For anyone who is interested:

Here is a link to a JSON parser built speficially for VBA:  GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA 

Using my code above, I tweaked it a bit to come up with this, which is working fairly well so far.  Probably some adjustments to come, but so far, so good.

Private Sub Command0_Click()
    Dim httpReq As New MSXML2.ServerXMLHTTP
    
    Dim fullAddress As String
    
    fullAddress = txtNumber & " " & txtStreetName & " " & txtType & " " & txtDir & ", " & cboMunicipality
    
    httpReq.Open "GET", "https://maps.durham.ca/arcgis/rest/services/Locators/ADDR_Locator/GeocodeServer/findAddressCandidate... Line Input=" & fullAddress & "&outfields=Score&f=json"

    httpReq.send
    Dim response As String
    response = httpReq.responseText
    
    Dim json As Object
    Set json = JsonConverter.ParseJson(response)
    
    Dim foundMatch As Boolean
    Dim alternateAddress As Variant
    Dim dimEd As Boolean
    
    dimEd = False
       
    On Error GoTo JSON_Handler:
    For i = 1 To 5
        If json("candidates")(i)("score") = 100 Then
            foundMatch = True
            MsgBox fullAddress & " is a valid address.", vbInformation, "Match Found"
            Exit Sub
        Else
            If dimEd = True Then
                ReDim Preserve alternateAddress(0 To UBound(alternateAddress) + 1) As String
            Else
                ReDim alternateAddress(0 To 0) As String
                dimEd = True
            End If
            
            alternateAddress(UBound(alternateAddress)) = json("candidates")(i)("address") & " - Score =  " & Round(json("candidates")(i)("score"), 2) & "%"
        End If
        
    Next i
    
JSON_Handler:
    If IsEmpty(alternateAddress) Then
        MsgBox "Provided address does not exist in our corporate address list.  There are no similar matching addresses.", vbInformation, "Address Not Valid"
        Exit Sub
    End If
    
    For i = 0 To UBound(alternateAddress)
        Dim list As String
        list = list & alternateAddress(i) & vbCr & vbCr
    Next i
    
    MsgBox "Provided address does not exist in our corporate address list.  Here are some similar addresses:" & vbCr & vbCr & list, vbInformation, "Alternate Addresses and Geocode Score"
    
    End Sub
0 Kudos