--**************************************
--
-- Name: Filter duplicate records from a
-- table
-- Description:Deletes duplicate records
-- from a table
-- By: Geoff Kazzi
--
-- Inputs:Database location
SQL string identifying how TO obtain the UNIQUE records
--
-- Returns:nothing
--
--This code is copyrighted and has-- limited warranties.Please see http://
-- www.Planet-Source-Code.com/vb/scripts/Sh
-- owCode.asp?txtCodeId=786&lngWId;=5--for details.--**************************************
--
sSQLUniqueRecords = "SELECT ProductID, ProductName, SupplierID, CategoryID, QuantityPerUnit, UnitPrice, UnitsInStock, UnitsOnOrder, ReorderLevel, Discontinued " & _
" FROM Products " & _
" GROUP BY ProductID, ProductName, SupplierID, CategoryID, QuantityPerUnit, UnitPrice, UnitsInStock, UnitsOnOrder, ReorderLevel, Discontinued
'DB location AND the sql string that creates the UNIQUE SET OF records
PUBLIC Sub DeleteDuplicateRecords(sDBLocation AS String, sSQLUniqueRecords As String)
' Deletes duplicates FROM the specified table.
' No USER confirmation IS required. Use WITH caution.
Const TempTable AS String = " INTO tempTableDup FROM "
Const DEL_TEMPTABLE AS String = "DROP TABLE tempTableDup"
Dim rst AS Recordset
Dim ADOAction AS New ADODB.Connection
Dim sTable AS String
Dim i AS Long
Dim j AS Integer
Dim sInsert AS String
DBcnn = "DRIVER={Microsoft Access Driver (*.mdb)};" & _
"DBQ=" & sDBLocation & ";" & _
"DefaultDir=" & sDBLocation
' get the TABLE name
sSQLUniqueRecords = UCase(sSQLUniqueRecords)
i = InStr(sSQLUniqueRecords, "FROM ") + 5
j = InStr(i, sSQLUniqueRecords, " ")
sTable = Mid(sSQLUniqueRecords, i, j - i)
' CREATE sql statement TO create TEMP TABLE
sSQLUniqueRecords = Replace(sSQLUniqueRecords, " FROM " & sTable, TempTable & sTable)
sInsert = "INSERT INTO " & sTable & " SELECT * FROM tempTableDup"
ADOAction.Open DBcnn' open a connection
ADOAction.Execute sSQLUniqueRecords, i ' CREATE TEMP TABLE WITH unique records
ADOAction.Execute "DELETE FROM " & sTable' delete ALL the old records IN the table
ADOAction.Execute sInsert, i' UPDATE the TABLE WITH the UNIQUE records FROM TEMP table
ADOAction.Execute DEL_TEMPTABLE ' DROP the temp table
SET ADOAction = Nothing
END Sub
|
