Dim Conn as ADODB.Connection Dim rsMDB as ADODO.Recordset Dim strCon As String Dim strDBSource As String Dim c11 As Collection, c12 As Collection, c13 As Collection Dim c21 As Collection, c22 As Collection, c23 As Collection Dim strSQL as String Dim intTabnum as Integer Dim i as Integer, j as Integer Dim booCommon as Boolean Dim x as Integer, y as Integer ' ----------------------------------------------------------------------------- ' If there is some better and more elegant manner of achieving the same thing, ' please submit your code to this site. It would be very helpful to me. ' -----------------------------------------------------------------------------

Sub GetCommonAttributes() Screen.MousePointer = 13 Set Conn = New ADODB.Connection strCon = "Data Source=E:\FRC\;" ' <!! Change to your database folder !!> With Conn .Provider = "Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;" .ConnectionString = strCon .Open End With Set c11 = New Collection Set c12 = New Collection Set c13 = New Collection ' All fields in first table are taken as the base and checked in all other ' tables. When it finds a match it returns True and checking stops for that ' field in that particular table. The next field is checked. If not ' found in one table, that field is removed from the collection. Finally, only ' the common Attributes will be left in the Collection strSQL = "Select * From Table1" <!! Change to your table name !!> Set rsMDB = Conn.Execute(strSQL) For i = 0 To rsMDB.Fields.Count - 1 c11.Add rsMDB.Fields(i).Name c12.Add rsMDB.Fields(i).Type c13.Add rsMDB.Fields(i).DefinedSize Next i rsMDB.Close ' Now check with all items in other tables, keeping c1 items constant With Conn .Provider = "Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;" .ConnectionString = strCon .Open End With ' I had my tables named Table1, Table2, etc and in one folder ' If you have yours in different folders, with different names you could ' retrieve the folder name using String functions and use a for loop right ' here to get each path and then each table name and connect to each table one ' after the other For intTabNum = 2 To 4 strSQL = "Select * From Table" & TabNum Set rsMDB = Conn.Execute(strSQL) Set c21 = New Collection Set c22 = New Collection Set c23 = New Collection For j = 0 To rsMDB.Fields.Count - 1 c21.Add rsMDB.Fields(j).Name c22.Add rsMDB.Fields(j).Type c23.Add rsMDB.Fields(j).DefinedSize Next I rsMDB.Close booCommon = False ' Used to check whether a field in Table 1 is in ' any of the other tables For x = 1 To c11.Count For y = 1 To c21.Count If c11(x) = c21(y) And c12(x) = c22(y) And c13(x) = c23(y) Then ' Field name, type and size are equal ---- booCommon = True Exit For ' Exit the inner For loop, because this ' field has already been found to be common Else ' Field not common to table 1 and this table, so return false ' and remove this field from all collections (c11, 12, 13) booCommon = False End If Next y ' Please trap error properly. I am still working on it. On Error Resume Next If booCommon = False Then c11.Remove (x) c12.Remove (x) c13.Remove (x) x = x - 1 End If Next x Next intTabNum Next i ' Finally, display the common attributes in a List box For k = 1 To c11.Count List1.AddItem c11(k) Next Set c11 = Nothing Set c12 = Nothing Set c13 = Nothing Set c21 = Nothing Set c22 = Nothing Set c23 = Nothing Conn1.close Screen.MousePointer = 1 End Sub