• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Code can be changed accordingly to read a bunch of dbf tables (can be easily modified to read .mdb

Code can be changed accordingly to read a bunch of dbf tables (can be easily modified to read .mdb

Code can be changed accordingly to read a bunch of dbf tables (can be easily modified to read .mdb etc tables) and check for common

API Declarations


Dim Conn as ADODB.Connection
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 Code can be changed accordingly to read a bunch of dbf tables (can be easily modified to read .mdb

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Screen.MousePointer = 13

Set Conn = New ADODB.Connection
    
strDBSource = "Data Source=E:\FRC\DBF;" <!! Change to your database folder !!>
strCon = strDBSource & "Extended Properties=""dBASE 5.0;"""
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 the fields in the first listed tables (eithe in a listbox or a Listview 
' or whatever control is taken as the base and checked in all other tables. 
' When it finds a match in another table, it returns True and checking stops
' for that field in that particular table. The next field is checked. If not 
' found in one table, it 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 rsDBF = Conn.Execute(strSQL)
For i = 0 To rsDBF.Fields.Count - 1
    c11.Add rsDBF.Fields(i).Name
    c12.Add rsDBF.Fields(i).Type
    'c13.Add rsDBF.Fields(i).DefinedSize
Next i
rsDBF.Close
    
' Now check with all items in other tables, keeping c1 items constant

For i = 2 To 200 <!! Get the number of tables that you want to check against !!>
 dSource = "Data Source=E:\FRC\DBF;"
 strCon = dSource & "Extended Properties=""dBASE 5.0;"""
        
 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
 For intTabNum = 2 To 4
    strSQL = "Select * From Table" & TabNum
    Set rsDBF = Conn.Execute(strSQL)
    Set c21 = New Collection
    Set c22 = New Collection
    Set c23 = New Collection
        
    For j = 0 To rsDBF.Fields.Count - 1
        c21.Add rsDBF.Fields(j).Name
        c22.Add rsDBF.Fields(j).Type
        c23.Add rsDBF.Fields(j).DefinedSize
    Next I
    rsDBF.Close
    
    booCommon = False

    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
                booCommon = True
                Exit For
            Else
                booCommon = False
            End If
        Next y
      ' Please trap error properly. I am still working on it.
      On Error Resume Next
                       
      If boo = False Then
          c11.Remove (x)
          c12.Remove (x)
          c13.Remove (x)
          x = x - 1
      End If
    Next x
Next intTabNum
' Finally, display the common attributes in a List box
Next i

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