Replace a Table

mdfx

New member
Local time
Today, 02:53
Joined
Jan 18, 2012
Messages
4
Hi, I have a large numbers of text files I'm sent regularly as they are changed/updated. I import them and replace the old ones, run some queries that are already written in Access and produce what I need.

I was trying to find something to speed up the import process, and so I used the code found at support.microsoft.com/kb/241477

Code:
Sub ImportSchemaTable()
    Dim db As DAO.Database
    Set db = CurrentDb()
    db.Execute _
    "SELECT * INTO NewContact FROM [Text;FMT=Delimited;HDR=Yes;DATABASE=C:\My documents;].[Contacts#txt];", _
    dbFailOnError
    db.TableDefs.Refresh
End Sub

It works perfectly if the tables are not already created. Could somebody more experienced suggest a revision to do a wholesale replacement of the tables?

Thank you!
 
Hi
This is a function i use to check whether a table exists when I have a need to. if the table doesn't exist in table defs access returns and error - this is trapped and the function returns a false. The DoCmd.RunSQL Syntax may be wrong (not used it for years) and also I assume the name of your table is "NewContact"

Code:
Private Sub ImportSchemaTable()
    Dim db As DAO.Database
    Dim strTBL As String
    strTBL = "NewContact"      'I assume this is the name of your table
    If TableExists(strTBL) = True Then
    DoCmd.RunSQL "DROP TABLE NewContact"
    End If
    Set db = CurrentDb()
    db.Execute _
    "SELECT * INTO NewContact FROM [Text;FMT=Delimited;HDR=Yes;DATABASE=C:\My documents;].[Contacts#txt];", _
    dbFailOnError
    db.TableDefs.Refresh
End Sub

Add in an extra function in the same module as your existing sub

Code:
Public Function TableExists(strTBL As String) As Boolean
'This sub traps error 3265 if a table is not in the tableDefs collection and outputs false to calling sub
Dim strTBL_CHK
On Error GoTo HandleError

'Look up the table name in the TableDefs Collection
strTBL_CHK = CurrentDb.TableDefs(strTBL)

'If it exists no error and we get to this line, true
TableExists = True

ExitCode:
    On Error Resume Next
    Exit Function

HandleError:
    Select Case Err.Number
        Case 3265  'Item not found in this collection
            TableExists = False
            Resume ExitCode
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "An unexpected error occured"
            Resume ExitCode
    End Select

End Function
 
Last edited:
This has worked swimmingly. No changes required. Thank you very much for the hand.
 

Users who are viewing this thread

Back
Top Bottom