DEVelopers HUT

'---------------------------------------------------------------------------------------
' Procedure : ImportAllTbls
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Import all the tables from an external Access database
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sExtDbPath - Full Path & Filename of the Database to import the tables from
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' ImportAllTbls "C:\Databases\development01.mdb"
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Jan-07                 Initial Release
'---------------------------------------------------------------------------------------
Sub ImportAllTbls(sExtDbPath As String)
On Error GoTo Error_Handler
    Dim db      As DAO.Database
    Dim tdf     As DAO.TableDef
 
    Set db = OpenDatabase(sExtDbPath)
 
    For Each tdf In db.TableDefs 'Loop through all the table in the external database
        If Left(tdf.Name, 4) <> "MSys" Then 'Exclude System Tables
            On Error Resume Next
            Access.DoCmd.TransferDatabase acImport, "Microsoft Access", sExtDbPath, _
                                          acTable, tdf.Name, tdf.Name, False
        End If
    Next tdf
    db.Close
 
    Set db = Nothing 'Cleanup after ourselves

Exit Sub
 
Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: ImportAllTbls" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Exit Sub
End Sub