Private db As ADODB.Connection
Private rs1 As ADODB.Recordset
Private rs2 As ADODB.Recordset
 
Private Sub Command_Click()
    Call fn_DeleteDuplicateRecords("Attribute", "TmpAttribute")
End Sub
 
Public Function fn_DeleteDuplicateRecords(ByVal strTableName As String, ByVal strDupTableName As String)
 
    Dim iCatalog As New ADOX.Catalog
    Dim i As Integer, j As Integer
    Dim strOpen As String
 
    On Error GoTo ErrTrap
 
    Set db = New ADODB.Connection
    Set rs1 = New ADODB.Recordset
    Set rs2 = New ADODB.Recordset
 
    db.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\ProductClass.mdb;Persist Security Info=False"
 
    iCatalog.ActiveConnection = db
 
    For i = 0 To iCatalog.Tables.Count() - 1
        If iCatalog.Tables(i).Name = "NEWTAB" Then 'If table strDupTableName found then
            db.Execute "DROP TABLE NEWTAB "
            iCatalog.Tables.Refresh
            Exit For
        End If
    Next
 
    db.Execute "CREATENEWTAB", , adCmdStoredProc
    rs1.Open " SELECT Attribute.ParentUUID, Attribute.Alias_Attr, First(Attribute.Value_Attr) AS FirstOfValue_Attr, Attribute.Type_Attr FROM " & strTableName & " GROUP BY Attribute.ParentUUID, Attribute.Alias_Attr, Attribute.Type_Attr ", db, adOpenKeyset, adLockReadOnly
    rs2.Open " SELECT * FROM NEWTAB ", db, adOpenDynamic, adLockOptimistic
 
    While Not rs1.EOF
        rs2.AddNew
        For i = 0 To rs1.Fields.Count - 1
            If i = 2 Then
                If Len(rs1.Fields(2)) > 255 Then
                    For j = 1 To Len(rs1.Fields(2)) Step 255
                        rs2.Fields(i) = rs2.Fields(i) & Mid(rs1.Fields(i), j, 255)
                    Next
                Else
                    rs2.Fields(i) = rs1.Fields(i)
                End If
            Else
                rs2.Fields(i) = rs1.Fields(i)
            End If
        Next i
        rs2.Update
        rs1.MoveNext
    Wend
 
    If Not rs1 Is Nothing Then
        If rs1.State Then rs1.Close
        Set rs1 = Nothing
    End If
    If Not rs2 Is Nothing Then
        If rs2.State Then rs2.Close
        Set rs2 = Nothing
    End If
 
    iCatalog.Tables.Refresh
    For i = 0 To iCatalog.Tables.Count() - 1
        If iCatalog.Tables(i).Name = "NEWTAB" Then 'If table strDupTableName found then
            db.Execute "DROP TABLE" & " " & strTableName 'Drop tables original
            iCatalog.Tables.Refresh
            Exit For
        End If
    Next
 
    'sometimes Maybe the Execution of the strOpen query is not completed yet.
    'u r trying to delete the original table only after the new table created is found.
    'so the above loop may result in not deleting the original table.
    'Or u try to get help of waiting till the query is executed by the ADO and get a intimation
    'once the query is finished and the new table with distinct records is created.
    iCatalog.Tables.Refresh
    For i = 0 To iCatalog.Tables.Count() - 1
        If iCatalog.Tables(i).Name = "NEWTAB" Then 'If table strDupTableName found then
            iCatalog.Tables(i).Name = strTableName 'rename to strTableNamer
            iCatalog.Tables.Refresh
            Exit For
        End If
    Next
    MsgBox "DELETED DUPLICATE RECORDS SUCCESSFULLY."
 
ErrTrap_Exit:
    If Not rs1 Is Nothing Then
        If rs1.State Then rs1.Close
        Set rs1 = Nothing
    End If
    If Not rs2 Is Nothing Then
        If rs2.State Then rs2.Close
        Set rs2 = Nothing
    End If
    If Not db Is Nothing Then
        If db.State Then db.Close
        Set db = Nothing
    End If
    If Not iCatalog Is Nothing Then
        Set iCatalog = Nothing
    End If
    Exit Function
 
ErrTrap:
    MsgBox Err.Number & " : " & Err.Description
    Resume ErrTrap_Exit
 
End Function