Dedupe and matchkey macro

New_to_this

New member
Local time
Yesterday, 22:08
Joined
Nov 20, 2018
Messages
7
Hi,

I need to run a dedupe macro based on the following,

Files supplied fields: Title, Forename, surname, address line 1 & postcode

I want to run a dedupe and flag where the files match on the following Criteria, address line 1 & postcode and create an additional field which states the matching criteria used

I would also like to build a matchkey on all the files based on the first 8 characters in address line 1 and the postcode and any spaces removed so would look like (36the streetSE94TH) and then run a dedupe and flag the records that match.


I have the below macro which imports all files in a set folder and append the file name, so would like to incorporate the above request in to this macro and run one process.

Public Sub btnImport_click()
ImportFilesInDir "c:\addresspoint"
End Sub


Public Sub ImportFilesInDir(ByVal pvDir)
Dim FSO, oFolder, oFile, oRX
Dim sTxt As String, sFile As String, sSql As String

On Error GoTo errGetFiles

DoCmd.SetWarnings False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(pvDir)

If Right(pvDir, 1) <> "" Then pvDir = pvDir & ""

For Each oFile In oFolder.Files
If InStr(oFile.Name, ".csv") > 0 Then 'import file here
sFile = pvDir & oFile.Name
DoCmd.TransferText acImportDelimi, , "P VSK Merged", sFile

sSql = "update [PETA VSK Merged] set filename ='" & sFile & "' where FILENAME is null"
DoCmd.RunSQL sSql
End If
Next

endit:
DoCmd.SetWarnings True
Set oFile = Nothing
Set oFolder = Nothing
Set FSO = Nothing
Exit Sub

errGetFiles:
If Err = 3265 Then 'catch error if NO Import table errors
' "no errors found"
Resume Next
Else
MsgBox Err.Description, , Err
End If
End Sub

thanks
sean
 

Users who are viewing this thread

Back
Top Bottom