Standardizing an Address

Created:01/09/2001
Description:

This VBA code demonstrates how to standardize a single address. The standardization results are displayed by this code.

If the Locator you are using supports intersection geocoding, then you must check each address to determine whether or not it is an intersection. Intersections are usually standardized differently than other addresses.


How to use:
  1. Paste this code into VBA.
  2. If you are using ArcMap, add a geocoding service to the document, and make it the current geocoding service. You can do this by choosing the geocoding service on the Addresses tab of the Find dialog box. Alternatively, you can use the Current Locator Control to do this.
  3. If you are using ArcCatalog, click a geocoding service in the ArcCatalog tree.
  4. Run the StandardizeAddress macro.
  5. When prompted, type the address that you want to find. Separate the address components with commas.
Option Explicit

Private Const ERR_NUMBER_WRONGNUMBEROFINPUTS = 1001
Private Const ERR_DESCRIPTION_WRONGNUMBEROFINPUTS = "The wrong number of address fields were specified."
Private Const ERR_NUMBER_REQUIREDFIELDMISSING = 1002
Private Const ERR_DESCRIPTION_REQUIREDFIELDMISSING = "A required address field was missing."

Private Const MESSAGEBOX_TITLE = "Standardize Address Geocoding Developer Tip"

Public Sub StandardizeAddress()

  Dim binIntersection As Boolean    'indicates if the address is an intersection address
  Dim i As Long   'loop counter
  Dim pAddressInputs As esriCore.IAddressInputs   'IAddressInputs interface on the Locator
  Dim pAddressFields As esriCore.IFields    'address input fields
  Dim pAddressPropertySet As esriCore.IPropertySet    'PropertySet containing input address components
  Dim pAdvancedGeocoding As esriCore.IAdvancedGeocoding   'IAdvancedGeocoding interface on the Locator
  Dim pAdvancedIntersectionGeocoding As esriCore.IAdvancedIntersectionGeocoding   'IAdvancedIntersectionGeocoding on the Locator
  Dim pApplication As esriCore.IApplication   'parent application of this module
  Dim pField As esriCore.IField   'field
  Dim pGxApplication As esriCore.IGxApplication   'ArcCatalog application
  Dim pGxLocator As esriCore.IGxLocator   'selected locator in ArcCatalog
  Dim pGxObject As esriCore.IGxObject   'selected object in ArcCatalog
  Dim pLocator As esriCore.ILocator  'locator
  Dim pMxApplication As esriCore.IMxApplication   'ArcMap application
  Dim pStandardizedPropertySet As esriCore.IPropertySet   'PropertySet containing the standardized address
  Dim pStandardizeFields As esriCore.IFields    'Fields collection for a standardized address
  Dim strAddress As String    'address string
  Dim strAddressFields As String    'string containing address field names
  Dim strStandardize As String    'string containing the standardize results
  
  On Error GoTo ErrorHandler
  
  '** get a reference to the parent application
  Set pApplication = ThisDocument.Parent
  If (TypeOf pApplication Is esriCore.IGxApplication) Then
    Set pGxApplication = pApplication
  ElseIf (TypeOf pApplication Is esriCore.IMxApplication) Then
    Set pMxApplication = pApplication
  End If

  '** get a Locator from the application
  If (TypeOf pApplication Is esriCore.IGxApplication) Then
    Set pGxObject = pGxApplication.SelectedObject
    If Not (TypeOf pGxObject Is esriCore.IGxLocator) Then
      MsgBox "The selected object is not a locator."
      Exit Sub
    End If
    Set pGxLocator = pGxObject
    Set pLocator = pGxLocator.Locator
  ElseIf (TypeOf pApplication Is esriCore.IMxApplication) Then
  End If

  '** get the address input fields for the locator
  If Not (TypeOf pLocator Is esriCore.IAddressInputs) Then
    MsgBox "The selected locator is not an address locator."
    Exit Sub
  End If
  Set pAddressInputs = pLocator
  Set pAddressFields = pAddressInputs.AddressFields
  For i = 0 To pAddressFields.FieldCount - 1
    Set pField = pAddressFields.Field(i)
    strAddressFields = strAddressFields & pField.Name
    If Not i = pAddressFields.FieldCount - 1 Then
      strAddressFields = strAddressFields & ","
    End If
  Next i

  '** prompt the user for the address
  Do
    strAddress = PromptForAddress(strAddressFields, strAddress)
    If strAddress = "" Then Exit Sub
    '** construct the address PropertySet
    Set pAddressPropertySet = ConstructAddressPropertySet(pAddressFields, strAddress)
    If Not pAddressPropertySet Is Nothing Then Exit Do
  Loop
  
  '** standardize the address
  Set pAdvancedGeocoding = pLocator
  Set pStandardizedPropertySet = pAdvancedGeocoding.StandardizeAddress(pAddressPropertySet, _
    binIntersection)
  
  '** if this is an intersection, then get the standardize fields for intersection
  If binIntersection Then
    Set pAdvancedIntersectionGeocoding = pLocator
    Set pStandardizeFields = pAdvancedIntersectionGeocoding.StandardizeIntersectionFields
  Else
    Set pStandardizeFields = pAdvancedGeocoding.StandardizeFields
  End If
  
  '** get the standardized address components
  For i = 0 To pStandardizeFields.FieldCount - 1
    Set pField = pStandardizeFields.Field(i)
    If Not (pField.Type = esriFieldTypeBlob Or pField.Type = esriFieldTypeGeometry _
      Or pField.Type = esriFieldTypeOID) Then
      strStandardize = strStandardize & pField.AliasName & ": " & _
        pStandardizedPropertySet.GetProperty(pField.Name) & vbNewLine
    End If
  Next i
  
  MsgBox strStandardize, vbInformation, MESSAGEBOX_TITLE
  
  Exit Sub

ErrorHandler:
  If (Err.Number = ERR_NUMBER_WRONGNUMBEROFINPUTS Or Err.Number = _
    ERR_NUMBER_REQUIREDFIELDMISSING) Then
    If MsgBox("An unexpected error occurred." & vbNewLine & _
      Err.Number & ": " & Err.Description, vbRetryCancel, MESSAGEBOX_TITLE) = vbCancel _
      Then Exit Sub
    Resume Next
  End If

End Sub

Private Function PromptForAddress(strAddressFields As String, _
  Optional strAddress As String = "") As String

  '** prompt the user for an address
  PromptForAddress = InputBox("Enter an address, separating the address fields with commas. " & _
    vbNewLine & vbNewLine & strAddressFields & ":", MESSAGEBOX_TITLE, strAddress)

End Function

Private Function ConstructAddressPropertySet(pFields As esriCore.IFields, _
  strAddress As String) As esriCore.IPropertySet

  Dim i As Long   'loop counter
  Dim pCollection As VBA.Collection   'collection containing address components
  Dim pField As esriCore.IField   'address field
  Dim PPropertySet As esriCore.IPropertySet   'PropertySet containing address components
  
  '** parse the address string to get the address components
  Set pCollection = ParseDelimitedString(strAddress, ",")
  If Not pCollection.Count = pFields.FieldCount Then
    Err.Raise ERR_NUMBER_WRONGNUMBEROFINPUTS, MESSAGEBOX_TITLE, _
      ERR_DESCRIPTION_WRONGNUMBEROFINPUTS
    Exit Function
  End If
  
  '** construct the PropertySet containing the address components
  Set PPropertySet = New esriCore.PropertySet
  For i = 1 To pCollection.Count
    Set pField = pFields.Field(i - 1)
    If pField.Required = True And pCollection(i) = "" Then
      Err.Raise ERR_NUMBER_REQUIREDFIELDMISSING, MESSAGEBOX_TITLE, _
        ERR_DESCRIPTION_REQUIREDFIELDMISSING
      Exit Function
    End If
    PPropertySet.SetProperty pField.Name, pCollection(i)
  Next i
  
  Set ConstructAddressPropertySet = PPropertySet
  
End Function

Private Function ParseDelimitedString(strString As String, strDelimiter As String) _
  As VBA.Collection

  Dim lngDelimiterPosition As Long  'position of the next delimiter in the string
  Dim lngStartPosition As Long  'starting character for search
  Dim pCollection As New VBA.Collection    'collection containing items in the string

  lngStartPosition = 1
  Do
    lngDelimiterPosition = InStr(lngStartPosition, strString, strDelimiter, vbTextCompare)
    If lngDelimiterPosition = 0 Then
      pCollection.Add Mid(strString, lngStartPosition, Len(strString) - lngStartPosition + 1)
      Exit Do
    Else
      pCollection.Add Mid(strString, lngStartPosition, lngDelimiterPosition - lngStartPosition)
      lngStartPosition = lngDelimiterPosition + 1
    End If
  Loop
  
  Set ParseDelimitedString = pCollection
  
End Function