табличка

Лог(
код - счётчик
База1
База2
Таблица
ТипРазличия
Строка
Поле
Значение1
Значение2)

функция

Public Sub FindDiff(File1 As String, File2 As String)
'findDiff "f:\t1.mdb","f:\t2.mdb"
'On Error GoTo err_me
Dim db1 As Database
Dim db2 As Database
Dim t1 As Recordset
Dim t2 As Recordset
Dim tbldef As TableDef
Dim tbldef2 As TableDef
Dim f1 As Field
Dim f2 As Field
Dim z1
Dim z2
Dim log As Recordset
Dim counterName As String
Dim is_diff As Boolean
Dim mess As String
Dim PK_found As Boolean
Dim table_found As Boolean
Dim f As Field
Dim f_2 As Field
Dim ind As Index
Dim t As TableDef
Dim field_found As Boolean
Dim recfound As Boolean
Dim Fields As String
Dim sep As String
Dim where As String
Dim fval As String
Dim ftype As Long
Dim i As Long
Debug.Print Now
CurrentDb.Execute "DELETE * FROM [Лог]"
Set log = CurrentDb.OpenRecordset("Лог", dbOpenTable)

Set db1 = Workspaces(0).OpenDatabase(File1)
Set db2 = Workspaces(0).OpenDatabase(File2)

For Each tbldef In db1.TableDefs
'MSys
If Mid(tbldef.Name, 1, 4) = "MSys" Then
GoTo Next_Table
End If
'если таблица помечена для пропуска - пропустить
If Not Nz(DLookup("ch", "SelectedTables", "Table='" & tbldef.Name & "'"), True) Then
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Пропускаем таблицу", " ", " ", " ", " "
GoTo Next_Table
End If
' beg do nothing for linked
If tbldef.Connect = "" Then
'ищем таблицу во второй базе
table_found = False
For Each t In db2.TableDefs
If t.Name = tbldef.Name Then
table_found = True
Exit For
End If
Next t
If Not table_found Then
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Нет таблицы в базе #2", " ", " ", " ", " "
GoTo Next_Table
End If
Set t = Nothing
Set tbldef2 = db2.TableDefs(tbldef.Name)
counterName = ""
For Each f In tbldef.Fields
If f.Attributes And dbAutoIncrField Then
counterName = f.Name
Exit For
End If
Next f
If counterName = "" Then
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Не найден Счётчик", " ", " ", " ", " "
GoTo Next_Table
End If
' ищем PK если нет счётчика
If counterName = "" Then
PK_found = False
For Each ind In tbldef.Indexes
If ind.Primary Then
counterName = ind.Fields(0).Name
PK_found = True
Exit For
End If
Next ind
If Not PK_found Then
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Не найден PK", " ", " ", " ", " "
GoTo Next_Table
End If
End If
'теперь поля
Fields = ""
sep = ""
For Each f In tbldef.Fields
field_found = False
For Each f_2 In tbldef2.Fields
If f_2.Name = f.Name Then
field_found = True
Exit For
End If
Next f_2
If field_found Then
If f.Type <> dbLongBinary And f.Type <> dbVarBinary And f.Type <> dbBinary Then
Fields = Fields & sep & "[" & f.Name & "]"
sep = ","
End If
Else
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Нет поля в таблице #2", f.Name, " ", " ", " "
End If
Next f
' если ни чего общего нет, то другую таблю
If Fields = "" Then
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Нет общих полей в таблице #2", "", "", "", ""
GoTo Next_Table
End If
Set f = Nothing
Set f_2 = Nothing

Set t1 = db1.OpenRecordset("SELECT " & Fields & " FROM [" & tbldef.Name & "] ORDER BY [" & counterName & "]")
Set t2 = db2.OpenRecordset("SELECT " & Fields & " FROM [" & tbldef.Name & "] ORDER BY [" & counterName & "]")

While Not t1.EOF
'пред проверка
If t2.EOF Then
' таблице 2 нет больше записей
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Нет записи в Таблице #2 eof", "[" & counterName & "]=" & t1.Fields(counterName).Value, " ", " ", " "
t1.MoveNext
GoTo Next_Record
End If
'проверка соответствия
z1 = t1.Fields(counterName).Value
z2 = t2.Fields(counterName).Value
' z1<z2 что-то удалено в таблице 2
If z1 < z2 Then
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Нет записи в Таблице #2", "[" & counterName & "]=" & z1, " ", " ", " "
t1.MoveNext
End If ' z1 < z2
' z1>z2 что-то удалено в таблице 1
If z1 > z2 Then
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Нет записи в Таблице #1", "[" & counterName & "]=" & z2, " ", " ", " "
t2.MoveNext
End If ' z1 > z2
' z1=z2 совпадают
If z1 = z2 Then
'раз есть такая запысь, она может отличаться
For i = 0 To t1.Fields.Count - 1
z1 = t1.Fields(i).Value
z2 = t2.Fields(i).Value
is_diff = False
If IsNull(z1) Then
' z1=Null
If Not IsNull(z2) Then
is_diff = True
End If
Else
' z1 <> Null
If IsNull(z2) Then
'Z1<>z2
is_diff = True
Else
'z2<>Null
If z1 <> z2 Then
is_diff = True
End If
End If
End If
If is_diff Then
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Разные значения", "[" & counterName & "]=" & t1.Fields(counterName).Value, t1.Fields(i).Name, z1, z2
End If
Next i
' к следущим
t1.MoveNext
t2.MoveNext
End If 'z1=z2
Next_Record:
Wend ' eof
Else
'
Write2Log log, db1.Name, db2.Name, tbldef.Name, "Таблица связанная", tbldef.Connect, " ", " ", " "
End If
' end do nothing for linked
Next_Table:
Set ind = Nothing
Set t1 = Nothing
Set t2 = Nothing
Set tbldef2 = Nothing
Next tbldef

exit_me:
db1.Close
db2.Close
Set db1 = Nothing
Set db2 = Nothing
Debug.Print Now
Exit Sub
err_me:
mess = Err.Description
Select Case Err.Number
Case Is = 0
mess = "Fig Znaet"
Case Else
'
End Select

Write2Log log, db1.Name, db2.Name, tbldef.Name, "Ошибка", mess, " ", " ", " "
Err.Clear
Resume Next
End Sub

Private Sub Write2Log(log As Recordset, db1 As String, db2 As String, tbl As String, diff_type As String, line As String, fld As String, z1, z2)

log.AddNew
log![База1] = db1
log![База2] = db2
log![Таблица] = tbl
log![ТипРазличия] = diff_type
log![Строка] = line
log![Поле] = fld
log![Значение1] = z1
log![Значение2] = z2
log.Update

End Sub