Tables |
1.8 Routine che confronta i records di due tabelle o query e identifica le differenze. |
Alberto Plano |
Public Sub Tabelle_a_confronto(Tab1 As string, Tab2 As String) 'Autore: Alberto Plano (albertoplano@iteco.it) 'Input: Nome delle due tabelle/query da confrontare. 'Tab1 e Tab2 devono avere la stessa struttura affinchè ' i risultati ottenuti siano sensati. 'Tab1 e Tab2 non devono contenere campi di tipo OLE. Dim dbase As DAO.Database Dim T1As DAO.Recordset, T2 As DAO.Recordset Dim campo As DAO.Field Dim aiuto1(), aiuto2() As String Dim indice1, indice2 As Long Set dbase = CurrentDb Set T1 = dbase.OpenRecordset(Tab1, dbOpenSnapshot) Set T2 = dbase.OpenRecordset(Tab2, dbOpenSnapshot) Rem Creo le matrici aiuto1 e aiuto2 T1.MoveLast T2.MoveLast ReDim aiuto1(1 To T1.RecordCount) ReDim aiuto2(1 To T2.RecordCount) T1.MoveFirst For indice1 = 1 To T1.RecordCount aiuto1(indice1) = "" For indice2 = 0 To T1.Fields.Count - 1 aiuto1(indice1) = aiuto1(indice1) + CStr(T1(indice2).Name) + " " + CStr(Null_to_zero(T1(indice2))) & Chr$(10) Next indice2 T1.MoveNext Next indice1 T2.MoveFirst For indice1 = 1 To T2.RecordCount aiuto2(indice1) = "" For indice2 = 0 To T2.Fields.Count - 1 aiuto2(indice1) = aiuto2(indice1) + CStr(T1(indice2).Name) + " " + CStr(Null_to_zero(T2(indice2))) & Chr$(10) Next indice2 T2.MoveNext Next indice1 Rem Elimino le stringhe uguali che sono contenute in Aiuto1 e Aiuto2 For indice1 = 1 To T1.RecordCount For indice2 = 1 To T2.RecordCount If aiuto1(indice1) = aiuto2(indice2) Then aiuto1(indice1) = "" aiuto2(indice2) = "" Exit For End If Next indice2 Next indice1 Rem Visualizzo i record di Tab1 che non sono contenuti in Tab2 Dim messaggio As String Dim uguale As Integer uguale = True For indice1 = 1 To T1.RecordCount If aiuto1(indice1) <> "" Then messaggio = "Record presente in " & Tab1 & " e mancante in " & Tab2 & Chr$(10) & Chr$(10) & aiuto1(indice1) MsgBox messaggio uguale = False End If Next indice1 For indice2 = 1 To T2.RecordCount If aiuto2(indice2) <> "" Then messaggio = "Record presente in " & Tab2 & " e mancante in " & Tab1 & Chr$(10) & Chr$(10) & aiuto2(indice2) MsgBox messaggio uguale = False End If Next indice2 If uguale Then MsgBox Tab1 & " e " & Tab2 & " sono identiche." End If End Sub Public Function Null_to_zero(a As Variant) As Variant If IsNull(a) Then Null_to_zero = 0 Else Null_to_zero = a End If End FunctionLa funzione può essere utile, ad esempio, per sapere quali records sono stati modificati dall'ultimo backup. NOTA Le funzioni di cui sopra fanno riferimento alla libreria Microsoft DAO quindi, se si usa una versione di Access successiva ad Access 97, è necessario aggiungere al database i riferimenti a Microsoft DAO 3.6 Object Library. |