مشكلة فى كود vba لا استطيع تطبيقه

[figo82eg]

ارجو من الأخوة الكرام مساعدتى فى حل كود vba من مثال لإستاذى @ابو البشر بخصوص مقارنة بيانات جدولين المثال عمل بنجاح معى فى قاعدة 

ولكن عند تطبيق نفس الخطوات على جدولين مختلفين من حيث تسمية الحقول لم ينجح

ارجو المساعدة

 

مقارنة بيانات.rar

تم تعديل نوفمبر 9, 2024 بواسطه figo82eg

[figo82eg]

ارجو المساعدة

[Foksh]

نيابة عن الأستاذ الفاضل @ابو البشر ، وبعد محاولة فهم طريقة عمل الكود في مشاركته الأصلية ، تفضل الكود التالي أخي @figo82eg .

في حدث عند النقر للزر :-

 

Private Sub أمر1_Click()
    Dim db As DAO.Database
    Dim rsOld As DAO.Recordset
    Dim rsNew As DAO.Recordset
    Dim rsDifferences As DAO.Recordset
    Dim fld As DAO.Field
    Dim recordFound As Boolean
    Dim commonFields As Collection
    Dim fieldName As Variant
    
    Set db = CurrentDb
    Set rsOld = db.OpenRecordset("BASIC_DATE")
    Set rsNew = db.OpenRecordset("Sap_Data")
    Set rsDifferences = db.OpenRecordset("DifferencesTable", dbOpenDynaset)
    
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE FROM DifferencesTable;"
    DoCmd.SetWarnings True
    
    Set commonFields = New Collection
    For Each fld In rsOld.Fields
        On Error Resume Next
        If Not IsNull(rsNew.Fields(fld.Name).Name) Then
            If fld.Name <> "CRN" Then
                commonFields.Add fld.Name, fld.Name
            End If
        End If
        On Error GoTo 0
    Next fld
    
    Do While Not rsOld.EOF
        recordFound = False
        rsNew.MoveFirst
        
        Do While Not rsNew.EOF
            If rsOld("CRN") = rsNew("CRN") Then
                recordFound = True
                
                For Each fieldName In commonFields
                    If Nz(rsOld(fieldName), "") <> Nz(rsNew(fieldName), "") Then
                        rsDifferences.AddNew
                        rsDifferences("ID") = rsOld("CRN")
                        rsDifferences("ChangeType") = "Modification"
                        rsDifferences("FieldName") = fieldName
                        rsDifferences("OldValue") = rsOld(fieldName)
                        rsDifferences("NewValue") = rsNew(fieldName)
                        rsDifferences.Update
                    End If
                Next fieldName
                Exit Do
            End If
            rsNew.MoveNext
        Loop
        
        If Not recordFound Then
            rsDifferences.AddNew
            rsDifferences("ID") = rsOld("CRN")
            rsDifferences("ChangeType") = "Deletion"
            rsDifferences("FieldName") = ""
            rsDifferences("OldValue") = "Record Deleted"
            rsDifferences("NewValue") = ""
            rsDifferences.Update
        End If
        
        rsOld.MoveNext
    Loop
    
    rsNew.MoveFirst
    Do While Not rsNew.EOF
        recordFound = False
        rsOld.MoveFirst
        
        Do While Not rsOld.EOF
            If rsNew("CRN") = rsOld("CRN") Then
                recordFound = True
                Exit Do
            End If
            rsOld.MoveNext
        Loop
        
        If Not recordFound Then
            rsDifferences.AddNew
            rsDifferences("ID") = rsNew("CRN")
            rsDifferences("ChangeType") = "Addition"
            rsDifferences("FieldName") = ""
            rsDifferences("OldValue") = ""
            rsDifferences("NewValue") = "Record Added"
            rsDifferences.Update
        End If
        
        rsNew.MoveNext
    Loop
    
    rsOld.Close
    rsNew.Close
    rsDifferences.Close
    Set rsOld = Nothing
    Set rsNew = Nothing
    Set rsDifferences = Nothing
    Set db = Nothing
    
    MsgBox "تمت مقارنة الجداول وتم تخزين جميع التغييرات في DifferencesTable."
    DoCmd.OpenQuery "abo_1", acViewNormal
End Sub

 

الملف بعد التعديل :

 

مقارنة بيانات.accdb

تم تعديل نوفمبر 9, 2024 بواسطه Foksh