Runtime error in MS-Access

[dinilkarun]

Hi,
I am using the following syntax in VB 6.0 to copy distinct values from strTableName to TableName

strOpen = "Select distinct * into" & " " & strDupTableName & " from " & strTableName
rst.Open strOpen, db, adOpenDynamic, adLockOptimistic

But I am getting a runtime error "-2147217833". I have 900 records in the table and all the fields are set to type "memo".

Please help me to resolve this error.

Regards,
Dinil

[aktharshaik]

use db.Execute

[aktharshaik]

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 that the remaining rows after the initial quantity specified in the CacheSize property should be fetched asynchronously.

Remarks
Using the Execute method on a Connection object executes whatever query you pass to the method in the CommandText argument on the specified connection. If the CommandText argument specifies a row-returning query, any results the execution generates are stored in a new Recordset object. If the command is not a row-returning query, the provider returns a closed Recordset object.

The returned Recordset object is always a read-only, forward-only cursor. If you need a Recordset object with more functionality, first create a Recordset object with the desired property settings, then use the Recordset object’s Open method to execute the query and return the desired cursor type.

The contents of the CommandText argument are specific to the provider and can be standard SQL syntax or any special command format that the provider supports.

An ExecuteComplete event will be issued when this operation concludes.

Execute, Requery, and Clear Methods Example
This example demonstrates the Execute method when run from both a Command object and a Connection object. It also uses the Requery method to retrieve current data in a recordset, and the Clear method to clear the contents of the Errors collection. The ExecuteCommand and PrintOutput procedures are required for this procedure to run.

Public Sub ExecuteX()

   Dim strSQLChange As String
   Dim strSQLRestore As String
   Dim strCnn As String
   Dim cnn1 As ADODB.Connection
   Dim cmdChange As ADODB.Command
   Dim rstTitles As ADODB.Recordset
   Dim errLoop As ADODB.Error

   ' Define two SQL statements to execute as command text.
   strSQLChange = "UPDATE Titles SET Type = " & _
      "'self_help' WHERE Type = 'psychology'"
   strSQLRestore = "UPDATE Titles SET Type = " & _
      "'psychology' WHERE Type = 'self_help'"

   ' Open connection.
      strCnn = "Provider=sqloledb;" & _
      "Data Source=srv;Initial Catalog=pubs;User Id=sa;Password=; "
   Set cnn1 = New ADODB.Connection
   cnn1.Open strCnn

   ' Create command object.
   Set cmdChange = New ADODB.Command
   Set cmdChange.ActiveConnection = cnn1
   cmdChange.CommandText = strSQLChange
   
   ' Open titles table.
   Set rstTitles = New ADODB.Recordset
   rstTitles.Open "titles", cnn1, , , adCmdTable

   ' Print report of original data.
   Debug.Print _
      "Data in Titles table before executing the query"
   PrintOutput rstTitles

   ' Clear extraneous errors from the Errors collection.
   cnn1.Errors.Clear

   ' Call the ExecuteCommand subroutine to execute cmdChange command.
   ExecuteCommand cmdChange, rstTitles
   
   ' Print report of new data.
   Debug.Print _
      "Data in Titles table after executing the query"
   PrintOutput rstTitles

   ' Use the Connection object's execute method to 
   ' execute SQL statement to restore data. Trap for 
   ' errors, checking the Errors collection if necessary.
   On Error GoTo Err_Execute
   cnn1.Execute strSQLRestore, , adExecuteNoRecords
   On Error GoTo 0

   ' Retrieve the current data by requerying the recordset.
   rstTitles.Requery

   ' Print report of restored data.
   Debug.Print "Data after executing the query " & _
      "to restore the original information"
   PrintOutput rstTitles

   rstTitles.Close
   cnn1.Close
   
   Exit Sub
   
Err_Execute:

   ' Notify user of any errors that result from
   ' executing the query.
   If Errors.Count > 0 Then
      For Each errLoop In Errors
         MsgBox "Error number: " & errLoop.Number & vbCr & _
            errLoop.Description
      Next errLoop
   End If
   
   Resume Next

End Sub

Public Sub ExecuteCommand(cmdTemp As ADODB.Command, _
   rstTemp As ADODB.Recordset)

   Dim errLoop As Error
   
   ' Run the specified Command object. Trap for 
   ' errors, checking the Errors collection if necessary.
   On Error GoTo Err_Execute
   cmdTemp.Execute
   On Error GoTo 0

   ' Retrieve the current data by requerying the recordset.
   rstTemp.Requery
   
   Exit Sub

Err_Execute:

   ' Notify user of any errors that result from
   ' executing the query.
   If Errors.Count > 0 Then
      For Each errLoop In Errors
         MsgBox "Error number: " & errLoop.Number & vbCr & _
            errLoop.Description
      Next errLoop
   End If
   
   Resume Next

End Sub

Public Sub PrintOutput(rstTemp As ADODB.Recordset)

   ' Enumerate Recordset.
   Do While Not rstTemp.EOF
      Debug.Print "  " & rstTemp!Title & _
         ", " & rstTemp!Type
      rstTemp.MoveNext
   Loop

End Sub

[dinilkarun]

Hi,

I am able to sucessfully delete duplicate records when the number of records are few in number say=50. But the same code is not working when the number of records are many say=500 or more.

Please help,
Dinil

[aktharshaik]

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

[dinilkarun]

Field(0)=1025C0A741001C016E4795480F000EAAFA0000000007454E4F564C52345C00000005446F63496430000104454E4F56085644656661756C741F003C44424D533E3C7264623E3C454E4F434F4D4D4F4E3E454E4F434F4D4D4F4E20000000679DA65D2184468F8716A39B64B4428B454E4F44525F424F4543414350726474

Field(1)= XXXXXYYYYYYZZZZZZZZ

Field(2)=AAAAAABBBBBBCCCCCC

Field(3)=XXXCCBBBDDDD

All the fields are of type: MEMO
Approrimate number of records are:1000

Error description: The field is too small to accept the amount of data you attempted to add. Try inserting or pasting less data.

Help!

[aktharshaik]

'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

[dinilkarun]

Public Function fn_DeleteDuplicateRecords(ByVal strTableName As String, ByVal strDupTableName As String)
Dim catalog As New ADOX.catalog
Dim i As Integer
Dim strOpen As String
Dim strOpen1 As String
Dim MySQL2 As String
Dim MySQL3 As String
Dim MySQL1 As String

Set db = New ADODB.Connection
db.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\ProductClass.mdb;Persist Security Info=False"
Set rst = New ADODB.Recordset

'On Error GoTo tableexist

strOpen = "Select distinct * into" & " " & strDupTableName & " from " & strTableName
Debug.Print strOpen

rst.Open strOpen, db, adOpenDynamic, adLockOptimistic

catalog.ActiveConnection = db

For i = 0 To catalog.Tables.Count() - 1
If catalog.Tables(i).Name = strDupTableName Then 'If table strDupTableName found then

MySQL3 = "DROP TABLE" & " " & strTableName
db.Execute MySQL3 'Drop tables original

catalog.Tables(i).Name = strTableName 'rename to strTableNamer
Exit For
End If
Next
' MsgBox "DUPLICATE RECORD WAS DELETED"
If (rst.State And adStateOpen) = adStateOpen Then
rst.Close
db.Close
End If
Set rst = Nothing
Set db = Nothing
Set catalog = Nothing
Exit Function

Through this code I am trying to delete duplicate table. Please help me out with this. I unable to upload the database. I have attached a snapshot of the Database. All fields in the database are set to MEMO. Please check both attachments.

[dinilkarun]

Thanks for the reply
pls provide me with your EMail address.I will mail you the .mdb file.

Regards
Dinil

[aktharshaik]

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
'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 = strDupTableName Then 'If table strDupTableName found then
iCatalog.Tables(i).Name = strTableName 'rename to strTableNamer
iCatalog.Tables.Refresh
Exit For
End If
Next

ErrTrap_Exit:
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

[aktharshaik]

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.

[aktharshaik]

check out the attachment

[aktharshaik]

check out the zip file attachment

[dinilkarun]

Hi,

Its still showing the same error. Can you send your database if its working there?

Regards,
Dinil

[aktharshaik]

I've already uploaded in the zip file.

[dinilkarun]

Hi,
I have attached my database. The code is not working on this database.
Please help.

[aktharshaik]

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.

[aktharshaik]

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 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 = strDupTableName Then 'If table strDupTableName found then
            iCatalog.Tables(i).Name = strTableName 'rename to strTableNamer
            iCatalog.Tables.Refresh
            Exit For
        End If
    Next

ErrTrap_Exit:
    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

[dinilkarun]

Hi,
Its working dude..!!! Thanx a ton!! :)

[aktharshaik]

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.