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!!
Solved! Go to Solution.
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
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