Compare Dabases: Get Properties Of Each Field In A Table, Access 2010

[DevelopV]

To help when when developing on an active database, I use the following to compare the fields in all tables in 2 databases.

Function TableInfo()

Dim PrimaryDatabase As String
Dim SecondaryDatabase As String
Dim Response As String
Dim Table As String
Dim TableNumber As Integer
Dim TableCount As Integer
Dim Field As String
Dim FieldNumber As Integer
Dim FieldCount As Integer
Dim rstDatabase As DAO.Recordset
Dim rstPrimary As DAO.Recordset
Dim rstSecondary As DAO.Recordset
Dim db As Database, dbsPrimary As Database, dbsSecondary As Database

Set db = CurrentDb

Set rstDatabase = db.OpenRecordset("tblDatabasePaths")
    With rstDatabase
        PrimaryDatabase = rstDatabase!PrimaryDatabasePath
        SecondaryDatabase = rstDatabase!SecondaryDatabasePath
    End With

'Set dbsSecondary = DBEngine.Workspaces(0).OpenDatabase("Contacts.mdb")
Set dbsPrimary = DBEngine.Workspaces(0).OpenDatabase(PrimaryDatabase)
Set dbsSecondary = DBEngine.Workspaces(0).OpenDatabase(SecondaryDatabase)

'Response = InputBox("Which database?", vbQuestion)

'Set rst = db.OpenRecordset("tblTablesFields")

Set rstPrimary = db.OpenRecordset("tblTablesFieldsPrimary")
Set rstSecondary = db.OpenRecordset("tblTablesFieldsSecondary")

DoCmd.SetWarnings False
DoCmd.RunSQL "delete * from tblTablesFieldsPrimary"
DoCmd.RunSQL "delete * from tblTablesFieldsSecondary"
DoCmd.SetWarnings True

With dbsPrimary
    TableCount = dbsPrimary.TableDefs.Count
    TableCount = TableCount - 1  'First record = 0
    
    Do Until TableCount < 0
    
        Table = dbsPrimary.TableDefs(TableCount).Name
  
        FieldCount = dbsPrimary.TableDefs(Table).Fields.Count
        FieldNumber = 1
        
        i = 0
        Do Until i = FieldCount
            
            Field = dbsPrimary.TableDefs(TableCount).Fields(i).Name
            
                With rstPrimary
                    .AddNew
                    !Database = PrimaryDatabase
                    !Table = Table
                    !Field = Field
                    !FieldNumber = FieldNumber
                    !Type = dbsPrimary.TableDefs(TableCount).Fields(i).Type
                    !Size = dbsPrimary.TableDefs(TableCount).Fields(i).Size
                    !DefaultValue = dbsPrimary.TableDefs(TableCount).Fields(i).DefaultValue
                    !Index = dbsPrimary.TableDefs(TableCount).Fields(i)
                    .update
                End With
            
            i = i + 1
            FieldNumber = FieldNumber + 1
            'FieldCount = FieldCount - 1
        
        Loop
        
        TableCount = TableCount - 1
        
    Loop
End With


With dbsSecondary
    TableCount = dbsSecondary.TableDefs.Count
    TableCount = TableCount - 1  'First record = 0
    
    Do Until TableCount < 0
    
        Table = dbsSecondary.TableDefs(TableCount).Name
  
        FieldCount = dbsSecondary.TableDefs(Table).Fields.Count
        FieldNumber = 1
        
        i = 0
        Do Until i = FieldCount
            
            Field = dbsSecondary.TableDefs(TableCount).Fields(i).Name
            
                With rstSecondary
                    .AddNew
                    !Database = SecondaryDatabase
                    !Table = Table
                    !Field = Field
                    !FieldNumber = FieldNumber
                    !Type = dbsSecondary.TableDefs(TableCount).Fields(i).Type
                    !Size = dbsSecondary.TableDefs(TableCount).Fields(i).Size
                    !DefaultValue = dbsSecondary.TableDefs(TableCount).Fields(i).DefaultValue
                    .update
                End With
            
            i = i + 1
            FieldNumber = FieldNumber + 1
            'FieldCount = FieldCount - 1
        
        Loop
        
        TableCount = TableCount - 1
        
    Loop
End With

MsgBox "Complete!"


End Function

I would like to include if a field is indexed, and if yes whether duplicates are allowed.
How do I check for this?

Many thanks

 

[MajP]

Public Function isPK(tblDef As DAO.TableDef, strField As String) As Boolean
  Dim idx As DAO.Index
  Dim fld As DAO.Field
  For Each idx In tblDef.Indexes
    If idx.Primary Then
      For Each fld In idx.Fields
        If strField = fld.Name Then
          isPK = True
          Exit Function
        End If
      Next fld
    End If
  Next idx
End Function

Public Function isIndex(tblDef As DAO.TableDef, strField As String) As Boolean
  Dim idx As DAO.Index
  Dim fld As DAO.Field
  For Each idx In tblDef.Indexes
     For Each fld In idx.Fields
        If strField = fld.Name Then
          isIndex = True
          Exit Function
         End If
      Next fld
  Next idx
End Function

Public Function isFK(tblDef As DAO.TableDef, strField As String) As Boolean
  Dim idx As DAO.Index
  Dim fld As DAO.Field
  For Each idx In tblDef.Indexes
    If idx.Foreign Then
      For Each fld In idx.Fields
        If strField = fld.Name Then
          isFK = True
          Exit Function
        End If
      Next fld
    End If
  Next idx
End Function

 

[MajP]

same technique for the "unique" property,
if idx.unique then ...