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
use db.Execute
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 SubHi,
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
type the table structure (fields and their datatypes) and also some sample records. i will try to solve it.
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!
'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
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.
Thanks for the reply
pls provide me with your EMail address.I will mail you the .mdb file.
Regards
Dinil
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
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.
check out the attachment
check out the zip file attachment
Hi,
Its still showing the same error. Can you send your database if its working there?
Regards,
Dinil
Hi,
I have attached my database. The code is not working on this database.
Please help.
I've already uploaded in the zip file.
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.
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 FunctionHi,
Its working dude..!!! Thanx a ton!! :)
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.
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 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 FunctionIs this code working on the database I sent you?.
No. But i added a query there named CREATENEWTAB
Also check out the field names in your database and the code. i had changed the field names here by appending _Attr to last three fields, because type, value etc may be some keywords or reserved VB words.
can you send me the database on which the above code is working?
Check this
dude... Its working on the 'Attribute' table. I am now trying to make it work for all the tables(8 of them in total). I will get back to you if I face any difficulties.
Thanks a lot.... Thanks once again.
Regards,
Dinil
I will get back to you soon
I have now made the code to work for all the tables.....
Thanks a lot dude.....
Keep in touch.:)....
Thanks once again....
Regards,
Dinil
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.