Posts by aktharshaik

Hi! Came out with the solution just now. plz check out this.

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 …

but just check out those records with more than 255 chars in the third column are truncated to 255 characters and the remaining data is lost.

OK DONE TRY THIS CODE.
WHEN YOU ARE QUERYING MEMO FIELDS ONLY THE FIRST 255 CHARACTERS ARE CONSIDERED. SO INSTEAD OF QUERYING THE FIELD DIRECTLY U CAN APPEND SOMETHING ELSE TO THE FIELD AND QUERY.

Private db As ADODB.Connection

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
    Dim strOpen As String

    On Error GoTo ErrTrap

    Set db = New ADODB.Connection
    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 = strDupTableName Then 'If table strDupTableName found then
            db.Execute "DROP TABLE" & " " & strDupTableName 'Drop tables if already exists
            iCatalog.Tables.Refresh
            Exit For
        End If
    Next

    strOpen = "SELECT DISTINCT ParentUUID, Alias_Attr, Value_Attr & ' ' as Value_Attr, Type_Attr INTO " & strDupTableName & " FROM " & strTableName
    db.Execute strOpen, , adCmdText 'Create the new Table with Distinct Records

    iCatalog.Tables.Refresh
    For i = 0 To iCatalog.Tables.Count() - 1
        If iCatalog.Tables(i).Name = strDupTableName 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 …

Ok. A few records in Value_Attr column are exceeding 255 characters. 2 records are having >2000 chars, 4recs having >1000chars and a few having nearly 600 records. A Memo field when accessed using DAO or ADO will consider it as a text field limiting the field size to 255. that's why the error.

Plz be patient i'll try to give u the solution also.

I've already uploaded in the zip file.

check out the zip file attachment

check out the attachment

Dropping a table and renaming the current table immediately using a catalog may result in problems. because the catalog is not yet refreshed to identify the deleted table. also the indices of all tables change once a table is deleted in the catalog.

Try this

Private db As ADODB.Connection

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
Dim strOpen As String

On Error GoTo ErrTrap

Set db = New ADODB.Connection
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 = strDupTableName Then 'If table strDupTableName found then
db.Execute "DROP TABLE" & " " & strDupTableName 'Drop tables if already exists
iCatalog.Tables.Refresh
Exit For
End If
Next

strOpen = "Select distinct * into " & strDupTableName & " from " & strTableName
db.Execute strOpen, , adCmdText 'Create the new Table with Distinct Records

iCatalog.Tables.Refresh
For i = 0 To iCatalog.Tables.Count() - 1
If iCatalog.Tables(i).Name = strDupTableName 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

'OK Try this once
'I tried it on my pc and it worked fine.
'if possible upload the database file in zip format here.

'First create a recordset which retreives all tables from the database
'and check if the new table u r creating is already existing/not.

Dim rs0 as New rs0 As ADODB.Recordset

Set rs0 = db.OpenSchema(adSchemaTables)
strOpen = "Select Distinct * into " & strDupTableName & " from " & strTableName

db.BeginTrans
rs0.Find "TABLE_NAME='" & strDupTableName & "'", , adSearchForward
If rs0.EOF = False Then
db.Execute " DROP TABLE " & strDupTableName
End If
db.Execute strOpen, , adCmdText
db.CommitTrans

type the table structure (fields and their datatypes) and also some sample records. i will try to solve it.

rst.open is to open a recordset, and u r trying to create a table. this is to be done using the connection object only.
use db.execute strOpen

Execute Method (ADO Connection)
Executes the specified query, SQL statement, stored procedure, or provider-specific text.

Syntax
For a non–row-returning command string:
connection.Execute CommandText, RecordsAffected, Options
For a row-returning command string:
Set recordset = connection.Execute (CommandText, RecordsAffected, Options)

Return Value
Returns a Recordset object reference.

Parameters
CommandText A String containing the SQL statement, table name, stored procedure, or provider-specific text to execute.

RecordsAffected Optional. A Long variable to which the provider returns the number of records that the operation affected.

Options Optional. A Long value that indicates how the provider should evaluate the CommandText argument. Can be one of the following values.

Constant Description
adCmdText Indicates that the provider should evaluate CommandText as a textual definition of a command.
adCmdTable Indicates that ADO should generate an SQL query to return all rows from the table named in CommandText.
adCmdTableDirect Indicates that the provider should return all rows from the table named in CommandText.
adCmdTable Indicates that the provider should evaluate CommandText as a table name.
adCmdStoredProc Indicates that the provider should evaluate CommandText as a stored procedure.
adCmdUnknown Indicates that the type of command in the CommandText argument is not known.
adAsyncExecute Indicates that the command should execute asynchronously.
adAsyncFetch Indicates …

use db.Execute