|
|
|
| Title | Use DAO to compare two Access databases' structure |
|---|
| Description | This example shows how to use DAO to compare two Access databases' structure in Visual Basic 6. |
|---|
| Keywords | DAO, database, compare, DB, Access |
|---|
| Categories | Database |
|---|
|
|
|
When the user enters two database names and clicks Compare, the program opens the databases and loops through the names of their tables. The program skips tables that have names starting with MSys to avoid the system tables.
If one database has a table that the other does not, then the program displays the table's name and the number of records it contains.
If the databases both contain a table with the same name, the program calls subroutine 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
txtResults.Text = ""
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.
results = results & String$(50, "*") & vbCrLf
results = results & "< " & table_def(0).Name & _
" (" & table_def(0).RecordCount & " " & _
"records)" & vbCrLf & vbCrLf
td_num(0) = td_num(0) + 1
ElseIf table_def(0).Name > table_def(1).Name Then
' DB 0 is missing a table.
results = results & String$(50, "*") & vbCrLf
results = results & "> " & table_def(1).Name & _
" (" & table_def(1).RecordCount & " " & _
"records)" & vbCrLf & vbCrLf
td_num(1) = td_num(1) + 1
Else
results = results & String$(50, "*") & vbCrLf
results = results & "= " & table_def(1).Name & _
vbCrLf
' Compare the tables.
results = results & CompareTables(db, table_def)
td_num(0) = td_num(0) + 1
td_num(1) = td_num(1) + 1
results = results & vbCrLf
End If
Loop
db(0).Close
db(1).Close
txtResults.Text = results
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
|
|
|
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
|
| |
|
| |
|
|
