Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleUse DAO to compare tables in two Access databases
DescriptionThis example shows how to use DAO to compare tables in two Access databases in Visual Basic 6.
KeywordsDAO, database, compare, DB, Access, tables
CategoriesDatabase
 
This program compares two tables in two databases. When the user enters two database names and clicks Load, the program opens the two databases and loops through their tables. When it finds tables with the same names in the two databases, it adds the name to the lstTables ListBox.
 
Private Sub cmdLoad_Click()
Dim i As Integer
Dim db(0 To 1) As DAO.Database
Dim td_num(0 To 1) As Integer
Dim table_def(0 To 1) As DAO.TableDef

    lstTables.Clear
    Screen.MousePointer = vbHourglass
    DoEvents

    ' Open the databases.
    For i = 0 To 1
        ' Open the database.
        On Error GoTo DBOpenError
        Set db(i) = DBEngine.Workspaces(0).OpenDatabase( _
            txtDb(i).Text, ReadOnly:=False)
        On Error GoTo 0

        ' Start with the first TableDef.
        td_num(i) = 0
        Set table_def(i) = db(i).TableDefs(0)
    Next i

    ' Compare the tables.
    Do While (td_num(0) < db(0).TableDefs.Count) And _
        (td_num(1) < db(1).TableDefs.Count)
        ' Get the TableDefs.
        Set table_def(0) = db(0).TableDefs(td_num(0))
        Set table_def(1) = db(1).TableDefs(td_num(1))

        ' See if they're the same table.
        If LCase$(Left$(table_def(0).Name, 4)) = "msys" Then
            ' Skip DB 0 system table.
            td_num(0) = td_num(0) + 1
        ElseIf LCase$(Left$(table_def(1).Name, 4)) = "msys" _
            Then
            ' Skip DB 1 system table.
            td_num(1) = td_num(1) + 1
        ElseIf table_def(0).Name < table_def(1).Name Then
            ' DB 1 is missing a table.
            td_num(0) = td_num(0) + 1
        ElseIf table_def(0).Name > table_def(1).Name Then
            ' DB 0 is missing a table.
            td_num(1) = td_num(1) + 1
        Else
            ' Both DBs have this table.
            lstTables.AddItem table_def(0).Name
            td_num(0) = td_num(0) + 1
            td_num(1) = td_num(1) + 1
        End If
    Loop
    db(0).Close
    db(1).Close

    cmdCompare.Enabled = False
    Screen.MousePointer = vbDefault
    Exit Sub

DBOpenError:
    If db(0) Is Nothing Then
        MsgBox "Error " & Err.Number & _
            " opening database " & _
            txtDb(0).Text & vbCrLf & Err.Description
    Else
        MsgBox "Error " & Err.Number & _
            " opening database " & _
            txtDb(1).Text & vbCrLf & Err.Description
        db(0).Close
    End If
    Screen.MousePointer = vbDefault
    Exit Sub
End Sub
 
When the user selects a table in the ListBox and clicks Compare, the program calls function CompareTables to compare the tables.
 
Private Sub cmdCompare_Click()
Dim i As Integer
Dim db(0 To 1) As DAO.Database
Dim td_num(0 To 1) As Integer
Dim table_def(0 To 1) As DAO.TableDef
Dim results As String

    Screen.MousePointer = vbHourglass
    DoEvents

    ' Open the databases.
    For i = 0 To 1
        ' Open the database.
        On Error GoTo DBOpenError
        Set db(i) = DBEngine.Workspaces(0).OpenDatabase( _
            txtDb(i).Text, ReadOnly:=False)
        On Error GoTo 0
    
        ' Get the selected TableDef.
        Set table_def(i) = db(i).TableDefs(lstTables.Text)
    Next i

    ' Compare the tables.
    results = CompareTables(db, table_def)

    Screen.MousePointer = vbDefault
    dlgResults.txtResults.Text = results
    dlgResults.Show vbModal
    Exit Sub

DBOpenError:
    If db(0) Is Nothing Then
        MsgBox "Error " & Err.Number & _
            " opening database " & _
            txtDb(0).Text & vbCrLf & Err.Description
    Else
        MsgBox "Error " & Err.Number & _
            " opening database " & _
            txtDb(1).Text & vbCrLf & Err.Description
        db(0).Close
    End If
    Screen.MousePointer = vbDefault
    Exit Sub
End Sub
 
Subroutine CompareTables verifies that the tables have the same number of columns and complains if they don't. It then looks through the tables' columns to see if their names and types match. If they don't, the program says so.

If the tables' columns match, then the program compares all of the tables' records. First it uses function DataWidth to see how wide the data in each column will be and calculates the maximum of that value and the column's name. It passes those widths to function RecordHeader, which generates column headers that are wide enough for the records.

Next the program examines all of the records in the tables sorted by all of their columns. (I'm being pretty lazy here. For example, I don't think you can sort on a Memo column.) When the program finds a record in one table that is not in the other, it displays the record.

 
Private Function CompareTables(db() As DAO.Database, _
    table_def() As DAO.TableDef) As String
Dim results As String
Dim i As Integer
Dim field_mismatch As Boolean
Dim col_wid() As Integer
Dim data_wid As Integer
Dim compare_value As Integer
Dim rs(0 To 1) As DAO.Recordset
Dim Value(0 To 1) As String
Dim query As String

    ' Verify that the tables have the same number of
    ' columns.
    If table_def(0).Fields.Count <> _
        table_def(1).Fields.Count Then
        CompareTables = "Tables have different numbers of " & _
            "fields"
        Exit Function
    End If

    ' Verify that the tables have the same colunm names and
    ' types.
    For i = 0 To table_def(0).Fields.Count - 1
        If table_def(0).Fields(i).Name <> _
            table_def(1).Fields(i).Name Then
            field_mismatch = True
        ElseIf table_def(0).Fields(i).Type <> _
            table_def(1).Fields(i).Type Then
            field_mismatch = True
        Else
            field_mismatch = False
        End If

        If field_mismatch Then
            results = results & "  Field " & i & ": " & _
                table_def(0).Fields(i).Name & _
                " (" & table_def(0).Fields(i).Type & ") <> " & _
                    "" & _
                table_def(1).Fields(i).Name & _
                " (" & table_def(1).Fields(i).Type & ")" & _
                    vbCrLf
        End If
    Next i
    If Len(results) > 0 Then
        CompareTables = results
        Exit Function
    End If

    ' Get the column widths.
    ReDim col_wid(0 To table_def(0).Fields.Count - 1)
    For i = 0 To table_def(0).Fields.Count - 1
        col_wid(i) = Len(table_def(0).Fields(i).Name)
        data_wid = DataWidth(table_def(0).Fields(i))
        If col_wid(i) < data_wid Then col_wid(i) = data_wid
    Next i

    ' Make a record header.
    results = results & RecordHeader(col_wid, table_def(0)) _
        & vbCrLf

    ' Select the records, ordered by all fields.
    query = "SELECT * FROM " & _
        table_def(0).Name & " ORDER BY "
    For i = 0 To table_def(0).Fields.Count - 1
        If table_def(0).Fields(i).Type <> dbMemo Then
            query = query & table_def(0).Fields(i).Name & _
                ", "
        End If
    Next i
    query = Left$(query, Len(query) - 2)

    Set rs(0) = db(0).OpenRecordset(query, dbOpenSnapshot)
    Set rs(1) = db(1).OpenRecordset(query, dbOpenSnapshot)

    ' Compare records.
    Do Until (rs(0).EOF Or rs(1).EOF)
        ' See which record comes before the other.
        compare_value = 0
        For i = 0 To table_def(0).Fields.Count - 1
            If table_def(0).Fields(i).Type <> dbMemo Then
                Value(0) = "" & rs(0).Fields(i)
                Value(1) = "" & rs(1).Fields(i)
                If Value(0) < Value(1) Then
                    compare_value = -1
                    Exit For
                ElseIf Value(0) > Value(1) Then
                    compare_value = 1
                    Exit For
                End If
            End If
        Next i

        ' See if the records match.
        If compare_value < 0 Then
            results = results & "< " & _
                RecordString(col_wid, rs(0)) & vbCrLf
            rs(0).MoveNext
        ElseIf compare_value > 0 Then
            results = results & "> " & _
                RecordString(col_wid, rs(1)) & vbCrLf
            rs(1).MoveNext
        Else
            ' They match. Skip this record.
            rs(0).MoveNext
            rs(1).MoveNext
        End If
    Loop

    ' Display remaining rs(0) records.
    Do Until (rs(0).EOF)
        results = results & "< " & RecordString(col_wid, _
            rs(0)) & vbCrLf
        rs(0).MoveNext
    Loop

    ' Display remaining rs(1) records.
    Do Until (rs(1).EOF)
        results = results & "> " & RecordString(col_wid, _
            rs(1)) & vbCrLf
        rs(1).MoveNext
    Loop

    rs(0).Close
    rs(1).Close

    CompareTables = results & vbCrLf
End Function
 
Function DataWidth returns an appropriate width for a column's data type.
 
Private Function DataWidth(ByVal field_def As Field)
    Select Case field_def.Type
        Case dbByte
            DataWidth = 3
        Case dbInteger
            DataWidth = 6
        Case dbLong, 14     ' Auto Number
            DataWidth = 11
        Case dbSingle
            DataWidth = 9
        Case dbDouble
            DataWidth = 17
        Case dbDecimal
            DataWidth = 17
        Case dbText
            DataWidth = field_def.Size
        Case dbMemo
            DataWidth = 4
        Case dbDate
            DataWidth = 19
        Case dbCurrency
            DataWidth = 7
        Case dbBoolean
            DataWidth = 3
        Case Else
            DataWidth = 3
    End Select
End Function
Private Function DataTypeName(ByVal data_type As Integer)
    Select Case data_type
        Case dbByte
            DataTypeName = "Byte"
        Case dbInteger
            DataTypeName = "Integer"
        Case dbLong
            DataTypeName = "Long Integer"
        Case dbSingle
            DataTypeName = "Single"
        Case dbDouble
            DataTypeName = "Double"
        Case dbDecimal
            DataTypeName = "Decimal"
        Case dbText
            DataTypeName = "Text"
        Case dbMemo
            DataTypeName = "Memo"
        Case dbDate
            DataTypeName = "Date"
        Case dbCurrency
            DataTypeName = "Currency"
        Case dbBoolean
            DataTypeName = "Boolean"
        Case 14
            DataTypeName = "Auto Number"
        Case Else
            DataTypeName = "???"
    End Select
End Function
 
Function FieldString returns a field's value formatted to a particular width. (You could modify this, for example, to left or right justify values depending on data type.)

Function RecordString returns the field strings for all of the fields in a record.

Function RecordHeader returns a string that displays all of the column names over a row of all dashes (----) to make a nice header.

 
Private Function FieldString(ByVal wid As Integer, ByVal _
    field_def As DAO.Field) As String
Dim mask As String

    mask = "!" & String$(wid, "@")
    If field_def.Type = dbMemo Then
        FieldString = Format$("Memo", mask)
    Else
        FieldString = Format$(field_def.Value, mask)
    End If
End Function

Private Function RecordString(col_wid() As Integer, ByVal _
    rs As DAO.Recordset) As String
Dim results As String
Dim i As Integer

    For i = 0 To rs.Fields.Count - 1
        results = results & FieldString(col_wid(i) + 1, _
            rs.Fields(i))
    Next i

    RecordString = results
End Function

Private Function RecordHeader(col_wid() As Integer, ByVal _
    table_def As DAO.TableDef) As String
Dim line1 As String
Dim line2 As String
Dim i As Integer
Dim mask As String

    line1 = "  "
    line2 = "  "

    For i = 0 To table_def.Fields.Count - 1
        mask = "!" & String$(col_wid(i) + 1, "@")
        line1 = line1 & Format$(table_def.Fields(i).Name, _
            mask)
        line2 = line2 & String$(col_wid(i), "-") & " "
    Next i

    RecordHeader = line1 & vbCrLf & line2
End Function
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated