List indexes from table columns in Access
This piece of code will list of a field in a Access table is indexed or not. The function can be called from a sub (as in this example) or can be called from your own subroutine.
'--Place code inside a module or on code behind form.
Option Compare Database
Option Explicit
'-- Calling subroutine : loops through all available tables in de .mdb or .accdb
1.Sub ListIndexesFromTable()
2.Dim obj As AccessObject
3.For Each obj In CurrentData.AllTables
4.Debug.Print obj.Name & " - Indexed:" & GetIndexed(obj.Name) '- prints the fieldnames output to the direct window
5.Next
6.End Sub
'-The GetIndexed(obj.Name) from the above subroutine calls the function below and passes the tablename on every cycle until all tables are passed.
Function GetIndexed(TableName As String) As String
Dim ind As DAO.Index
Dim db As DAO.Database
Dim fld As DAO.Field
Dim tdf As DAO.TableDef
Dim strField As String
Dim intPass As Integer
'References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
'Set references by Clicking Tools and Then References in the Code View window
' Get all Indexed Fields and find the Primary Key in table TableName.
' Accepts
' TableName: Name of table in which the field is located
' Returns the Primary Key and All Fields and their Indexes in a table
Set db = CurrentDb()
Set tdf = db.TableDefs(TableName)
'Loop through all fields
For Each fld In tdf.Fields
'Toggle to 1 to record fields with no Index
intPass = 1
For Each ind In tdf.Indexes
If ind.Fields.Count = 1 Then
If ind.Fields(0).Name = fld.Name Then
'Toggle to record fields with an Index
intPass = 0
If ind.Primary Then
'Record the field name and Primary Key value
strField = strField & fld.Name & " Primary Key = " & ind.Primary & vbCrLf
ElseIf ind.Unique Then
'Record the field name and Unique Index value
strField = strField & fld.Name & " Yes (No Duplicates) " & ind.Unique & vbCrLf
ElseIf ind.Unique = False Then
'Record the field name and Non-Unique Index value
strField = strField & fld.Name & " Yes (Duplicates OK)" & ind.Unique & vbCrLf
End If
End If
End If
Next
'Record Fields with no Index
If intPass = 1 Then
'Record the field name
strField = strField & fld.Name & vbCrLf
End If
Next
GetIndexed = strField
ExitHere:
Set db = Nothing
Set ind = Nothing
Set fld = Nothing
Set tdf = Nothing
Exit Function
ErrHandler:
With Err
'There is an error return it
GetIndexed = "Error " & .Number & vbCrLf & .Description & " GetIndexed"
End With
Resume ExitHere
End Function