Author : AKR
Date Submitted : 11/8/2001
Category : Database
Compatibility : VB 6
This code has been accessed 9953 times.
Task : Display Common attributes of MS Access tables-ADO
Declarations
Code
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