• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Display Common attributes of MS Access tables-ADO

Display Common attributes of MS Access tables-ADO

Display Common attributes of MS Access tables-ADO

API Declarations


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.
' -----------------------------------------------------------------------------



Rate Display Common attributes of MS Access tables-ADO

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

 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