Geocoding a Table of Addresses

Created:01/09/2001
Description:

This VBA code demonstrates how to geocode a table of addresses.

To geocode a table of addresses, you must specify which fields in the table contain address information. Next, you must construct a set of fields for the output feature class. Finally, use the Locator to geocode the table.

In order to be able to rematch the geocoded feature class, you must copy the fields that contain the address information in the table to the geocoded feature class. By default, ArcGIS creates two copies of the address fields: one copy maintains the original address information from the table. The other copy can be edited when you rematch the feature class interactively. You must also attach a Locator to the geocoded feature class in order to be able to rematch it.

This sample creates a static geocoded feature class that is not related to the table of addresses. In order create a dynamic geocoded feature class that is related to the table of addresses, you must create a relationship class between the table and the geocoded feature class, register the geocoded feature class as containing GeocodedFeature objects, and set the ObjectClassExtension on the geocoded feature class to be the GeocodedFeatureClassExtension.


How to use:
  1. Paste this code into VBA in ArcCatalog.
  2. In the ArcCatalog tree, select a table containing address information.
  3. Run the MatchTable macro.
  4. When prompted, browse for a geocoding service to use to geocode the table.
  5. When prompted, specify the location and name of the geocoded feature class or shapefile.
Option Explicit

Private Const ERR_NUMBER_REQUIREDFIELDMISSING = 1002
Private Const ERR_DESCRIPTION_REQUIREDFIELDMISSING = "A required address field was missing."
Private Const MESSAGEBOX_TITLE = "Match Table Geocoding Developer Tip"

Public Sub MatchTable()

  Const FIELD_FID_NAME = "OBJECT_ID"  'ObjectID field name in the geocoded feature class
  Const UID_FEATURE = "esricore.Feature" 'UID for simple features

  Dim binOIDFieldFound As Boolean   'indicates if the OID field in the table has been inspected
  Dim i As Long   'loop counter
  Dim pAddressGeocoding As esriCore.IAddressGeocoding   'IAddressGeocoding interface on the Locator
  Dim pClass As esriCore.IClass   'IClass interface on the table
  Dim pFeatureClass As esriCore.IFeatureClass   'geocoded feature class
  Dim pFeatureDataset As esriCore.IFeatureDataset   'output feature dataset selected by the user
  Dim pFeatureWorkspace As esriCore.IFeatureWorkspace   'feature workspace for the output database selected by the user
  Dim pFieldEdit As esriCore.IFieldEdit   'field in the geocoded feature class
  Dim pGxApplication As esriCore.IGxApplication   'ArcCatalog application
  Dim pGxDatabase As esriCore.IGxDatabase   'output database selected by the user
  Dim pGxDataset As esriCore.IGxDataset   'output feture dataset selected by the user
  Dim pGxFile As esriCore.IGxFile   'IGxFile interface on the output folder selected by the user
  Dim pGxObject As esriCore.IGxObject   'selected object in the ArcCatalog tree
  Dim pGxOutputDataset As esriCore.IGxDataset   'output feature dataset specified by the user
  Dim pGxOutputLocation As esriCore.IGxObject   'output location specified by the user
  Dim pLocator As esriCore.ILocator   'Locator to use to match the table
  Dim pLocatorAttach As esriCore.ILocatorAttach   'ILocatorAttach interface on the LocatorWorkspace
  Dim pLocatorDataset As esriCore.ILocatorDataset   'ILocatorDataset interface on the Locator
  Dim pMatchFields As esriCore.IFields    'match fields for the Locator
  Dim pOutputFields As esriCore.IFieldsEdit   'fields for the geocoded feature class
  Dim PPropertySet As esriCore.IPropertySet   'PropertySet containing fields to copy
  Dim pTable As esriCore.ITable   'selected table
  Dim pTableFields As esriCore.IFields    'collection of fields to copy from the table
  Dim pTableFieldsEdit As esriCore.IFieldsEdit    'collection of fields to copy from the table
  Dim pUID As esriCore.UID    'GUID for features
  Dim pWorkspaceFactory As esriCore.IWorkspaceFactory   'shapefile workspace factory
  Dim strAddressFieldNames As String    'address input field names
  Dim strOutputFieldNames As String   'names of the match fields in the output feature class
  Dim strOutputName As String   'name of the geocoded feature class
  Dim strShapeFieldName As String   'name of the shape field
  
  On Error GoTo ErrorHandler
  
  '** get the selected Table
  Set pGxApplication = ThisDocument.Parent
  Set pGxObject = pGxApplication.SelectedObject
  If Not (TypeOf pGxObject Is esriCore.IGxDataset) Then
    MsgBox "The selected object is not a table.", vbCritical, MESSAGEBOX_TITLE
    Exit Sub
  End If
  Set pGxDataset = pGxObject
  If Not (pGxDataset.Type = esriDTTable) Then
    MsgBox "The selected object is not a table.", vbCritical, MESSAGEBOX_TITLE
    Exit Sub
  End If
  Set pTable = pGxDataset.Dataset

  '** browse for a Locator to geocode this table
  Set pLocator = BrowseForLocator
  If pLocator Is Nothing Then Exit Sub
  
  '** get the names of the fields that contain the address information
  strAddressFieldNames = GetAddressFieldNames(pLocator, pTable)
  
  '** create a set of fields to copy from the table
  Set pClass = pTable
  If pClass.HasOID Then
    Set pTableFieldsEdit = New esriCore.Fields
    pTableFieldsEdit.FieldCount = pTable.Fields.FieldCount - 1
    For i = 0 To pTable.Fields.FieldCount - 1
      If pTable.Fields.Field(i).Type = esriFieldTypeOID Then
        binOIDFieldFound = True
      Else
        If binOIDFieldFound Then
          Set pTableFieldsEdit.Field(i - 1) = pTable.Fields.Field(i)
        Else
          Set pTableFieldsEdit.Field(i) = pTable.Fields.Field(i)
        End If
      End If
    Next i
  Else
    Set pTableFieldsEdit = pTable.Fields
  End If
  
  '** create a set of fields for the output feature class
  Set pAddressGeocoding = pLocator
  Set pMatchFields = pAddressGeocoding.MatchFields
  Set pOutputFields = New esriCore.Fields
  Set pTableFields = pTableFieldsEdit
  pOutputFields.FieldCount = pTableFields.FieldCount + pMatchFields.FieldCount + 1
  '** create a feature ID field
  Set pFieldEdit = New esriCore.Field
  With pFieldEdit
    .Type = esriFieldTypeOID
    .Name = FIELD_FID_NAME
  End With
  Set pOutputFields.Field(0) = pFieldEdit
  '** add the fields from the table
  For i = 1 To pTableFields.FieldCount
    Set pOutputFields.Field(i) = pTableFields.Field(i - 1)
  Next i
  '** add the match fields
  For i = 1 + pTableFields.FieldCount To pMatchFields.FieldCount + pTableFields.FieldCount
    Set pOutputFields.Field(i) = pMatchFields.Field(i - pTableFields.FieldCount - 1)
  Next i
  
  '** browse for a location in which to create the geocoded feature class
  If Not BrowseForOutput(pGxOutputLocation, strOutputName) Then Exit Sub

  '** create the feature class for geocoding output
  '** create a UID for simple features
  Set pUID = New esriCore.UID
  pUID.Value = UID_FEATURE
  '** get the name of the shape field
  For i = 0 To pMatchFields.FieldCount - 1
    If pMatchFields.Field(i).Type = esriFieldTypeGeometry Then
      strShapeFieldName = pMatchFields.Field(i).Name
      Exit For
    End If
  Next i
  If (TypeOf pGxOutputLocation Is esriCore.IGxDataset) Then
    Set pGxOutputDataset = pGxOutputLocation
    Set pFeatureDataset = pGxOutputDataset.Dataset
    Set pFeatureClass = pFeatureDataset.CreateFeatureClass(strOutputName, pOutputFields, pUID, Nothing, esriFTSimple, _
      strShapeFieldName, "")
  ElseIf (TypeOf pGxOutputLocation Is esriCore.IGxDatabase) Then
    Set pGxDatabase = pGxOutputLocation
    Set pFeatureWorkspace = pGxDatabase.Workspace
    Set pFeatureClass = pFeatureWorkspace.CreateFeatureClass(strOutputName, pOutputFields, pUID, Nothing, esriFTSimple, _
      strShapeFieldName, "")
  ElseIf (TypeOf pGxOutputLocation Is esriCore.IGxFolder) Then
    Set pGxFile = pGxOutputLocation
    Set pWorkspaceFactory = New esriCore.ShapefileWorkspaceFactory
    Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(pGxFile.Path, 0)
    Set pFeatureClass = pFeatureWorkspace.CreateFeatureClass(strOutputName, pOutputFields, pUID, Nothing, esriFTSimple, _
      strShapeFieldName, "")
  End If

  '** create the set of output field names
  For i = 0 To pMatchFields.FieldCount - 1
    strOutputFieldNames = strOutputFieldNames & pMatchFields.Field(i).Name
    If Not (i = pMatchFields.FieldCount - 1) Then
      strOutputFieldNames = strOutputFieldNames & ","
    End If
  Next i

  '** create an PropertySet to specify the fields to copy from the table
  Set PPropertySet = New esriCore.PropertySet
  For i = 0 To pTableFields.FieldCount - 1
    PPropertySet.SetProperty pTableFields.Field(i).Name, pTableFields.Field(i).Name
  Next i

  '** geocode the table of addresses
  pAddressGeocoding.MatchTable pTable, strAddressFieldNames, "", pFeatureClass, strOutputFieldNames, PPropertySet

  '** attach a locator to the geocoded feature class
  Set pLocatorDataset = pLocator
  Set pLocatorAttach = pLocatorDataset.LocatorWorkspace
  pLocatorAttach.AttachLocator pLocator, pFeatureClass, pFeatureClass, strAddressFieldNames, FIELD_FID_NAME, _
    pFeatureClass, strOutputFieldNames, FIELD_FID_NAME

  Exit Sub

ErrorHandler:
    MsgBox "An unexpected error occurred." & vbNewLine & Err.Number & ": " & Err.Description, vbCritical, _
    MESSAGEBOX_TITLE, Err.HelpFile, Err.HelpContext
    
End Sub

Private Function BrowseForLocator() As esriCore.ILocator

  Const GXDIALOG_BUTTON = "Open"
  Const GXDIALOG_TITLE = "Select a geocoding service..."
  
  Dim pEnumGxObject As esriCore.IEnumGxObject   'enumeration of selected objects
  Dim pGxDialog As esriCore.IGxDialog   'ArcCatalog mini-browser dialog
  Dim pGxLocator As esriCore.IGxLocator   'selected Locator
  Dim pGxObject As esriCore.IGxObject   'selected GxObject
    
  '** create the GxDialog and browse for feature classes
  Set pGxDialog = New esriCore.GxDialog
  With pGxDialog
    .ButtonCaption = GXDIALOG_BUTTON
    .Title = GXDIALOG_TITLE
    Set .ObjectFilter = New esriCore.GxFilterGeocodingServices
    If .DoModalOpen(ThisDocument.Parent.hWnd, pEnumGxObject) = False Then Exit Function
  End With

  pEnumGxObject.Reset
  Set pGxObject = pEnumGxObject.Next
  Set pGxLocator = pGxObject
  Set BrowseForLocator = pGxLocator.Locator
  
End Function

Private Function BrowseForOutput(ByRef pGxObject As esriCore.IGxObject, ByRef strName As String) As Boolean

  Const GXDIALOG_BUTTON = "Save"
  Const GXDIALOG_TITLE = "Select a location for the geocoded feature class..."
  
  Dim pESRILicenseInfo As esriCore.IESRILicenseInfo    'license information object
  Dim pGxDialog As esriCore.IGxDialog   'ArcCatalog mini-browser dialog
  Dim pGxObjectFilter As esriCore.IGxObjectFilter   'ArcCatalog filter
  Dim pGxObjectFilterCollection As esriCore.IGxObjectFilterCollection    'IGxObjectFilterCollection on the GxDialog
    
  '** set the function's default value to false
  BrowseForOutput = False
    
  '** create the ArcCatalog mini-browser and set the filters
  Set pGxDialog = New esriCore.GxDialog
  Set pGxObjectFilterCollection = pGxDialog
  pGxObjectFilterCollection.RemoveAllFilters
  '** add shapefile filter
  Set pGxObjectFilter = New esriCore.GxFilterShapefiles
  pGxObjectFilterCollection.AddFilter pGxObjectFilter, False
  '** add the personal geodatabase feature class filter
  Set pGxObjectFilter = New esriCore.GxFilterPGDBFeatureClasses
  pGxObjectFilterCollection.AddFilter pGxObjectFilter, False
  '** if the user does not have an ArcView license, add the ArcSDE feature class filter
  Set pESRILicenseInfo = New esriCore.ESRILicenseInfo
  If Not pESRILicenseInfo.DefaultProduct = esriProductCodeViewer Then
    Set pGxObjectFilter = New esriCore.GxFilterSDEFeatureClasses
    pGxObjectFilterCollection.AddFilter pGxObjectFilter, False
  End If
  
  '** set options for the dialog and displays it
  With pGxDialog
    .ButtonCaption = GXDIALOG_BUTTON
    .Title = GXDIALOG_TITLE
    Do
      If .DoModalSave(ThisDocument.Parent.hWnd) = False Then Exit Function
      If .ReplacingObject Then
        MsgBox "Feature class already exists.", vbCritical, MESSAGEBOX_TITLE
      Else
        Exit Do
      End If
    Loop
  End With
  
  '** set the return values for the function
  Set pGxObject = pGxDialog.FinalLocation
  strName = pGxDialog.Name
  BrowseForOutput = True

End Function

Private Function GetAddressFieldNames(pAddressInputs As esriCore.IAddressInputs, pTable As esriCore.ITable) As String

  Dim binFieldFound As Boolean    'indicates if an address input field was found in the table
  Dim i, j, k As Long  'loop counters
  Dim pAddressFields As esriCore.IFields   'address input fields for the locator
  Dim pTableFields As esriCore.IFields    'fields collection from the table
  Dim strAddressFieldNames As String    'string containing address field names
  Dim strDefaultInputFieldNames() As String   'array of default names for a field
  
  Set pTableFields = pTable.Fields
  Set pAddressFields = pAddressInputs.AddressFields
  
  '** search the table to find each of the address input fields
  For i = 0 To pAddressFields.FieldCount - 1
    binFieldFound = False
    '** get the default names for this field
    strDefaultInputFieldNames = pAddressInputs.DefaultInputFieldNames(pAddressFields.Field(i).Name)
    '** search for the default names in the table
    For j = LBound(strDefaultInputFieldNames) To UBound(strDefaultInputFieldNames)
      For k = 0 To pTableFields.FieldCount - 1
        '** compare the default name to this field's name
        If StrComp(pTableFields.Field(k).Name, strDefaultInputFieldNames(j), vbTextCompare) = 0 Then
          strAddressFieldNames = strAddressFieldNames & pTableFields.Field(k).Name
          If Not i = pAddressFields.FieldCount - 1 Then
            strAddressFieldNames = strAddressFieldNames & ","
          End If
          binFieldFound = True
          Exit For
        End If
      Next k
      If binFieldFound Then Exit For
    Next j
    If Not (binFieldFound) Then
      '** if the field was required, then raise an error, otherwise, just add a comma to the string
      If pAddressFields.Field(i).Required Then
        Err.Raise ERR_NUMBER_REQUIREDFIELDMISSING, MESSAGEBOX_TITLE, ERR_DESCRIPTION_REQUIREDFIELDMISSING
        Exit Function
      Else
        If Not i = pAddressFields.FieldCount - 1 Then
          strAddressFieldNames = strAddressFieldNames & ","
        End If
      End If
    End If
  Next i
  
  GetAddressFieldNames = strAddressFieldNames
  
End Function