MS Access VBA Import all MS Access Databases in a Directory for versions 2000, 2002, 2003, 2007

Public Sub ImportMDB(spath As String , lst As ListBox)

   Dim Db As Database ' DAO Vars

   'References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
   'Set references by Clicking Tools and Then References in the Code View window
   ' Imports all tables in all external MS Access Databases (.mdb)
   ' The Code assumes the Start path is the current database path
   ' Accepts
   ' spath: "\" or folder name and "\"
   ' FieldName: Name of the field to create in the table
   ' Returns True on success, false otherwise.
   'USAGE: ImportMDB "spath"

   On Error GoTo errhandler 'If there is an error capture the error.

   Dim objFS As Object , objFolder As Object
   Dim objFiles As Object , objF1 As Object
   Dim strPath As String , strTableName As String , tblname As String
   Dim strSql As String , mpath As String
   Dim FileLen As Integer , i As Integer , X As Integer , n As Integer

   'Did we forget a "\" before we insert the file name
   If Len(spath) > 0 Then
      If Left(spath, 1 ) <> "\" Then
         spath = "\" & spath
         If Right(spath, 1 ) <> "\" Then
            spath = spath & "\"
         End If
      End If

   Else
      spath = "\"
   End If

   'Set import Path
   strPath = CurrentProject.Path & spath
   'Ensure we have not made double "\" anywhere.
   strPath = Replace(strPath, "\\" , "\" )

   'Set Scripting Variables to retrieve files
   Set objFS = CreateObject( "Scripting.FileSystemObject" )
   Set objFolder = objFS.GetFolder(strPath)
   Set objFiles = objFolder.files

   Set Db = CurrentDb()

   'Loop through the files
   For Each objF1 In objFiles

      'Check for our file extension mdb and
      'Check our file against our current mdb so we do not re-import tables

      If Right(objF1.Name, 3 ) = "mdb" And CurrentDb.Name <> strPath & objF1.Name Then
         'for Access 2007: Delete above line Uncomment following line
         'If Right(objF1.Name, 5) = "accdb" And CurrentDb.Name <> strPath & objF1.Name Then
         FileLen = Len(objF1.Name)

         'Set the Table Name to import as using the file name
         'Without the file extension
         strTableName = Left(objF1.Name, FileLen - 4 )
         'For Access2007: Delete above line Uncomment following line
         'strTableName = Left(objF1.Name, FileLen - 6)

         'Finalize Path
         mpath = strPath & objF1.Name

         'Grab external Database's Tables
         'and add to Listbox
         GetAllExternalTables strPath, objF1.Name, lst 

         With lst
            'Loop through the Tables in the Listbox
            For i = 0 To .ListCount - 1

               'set table name
               tblname = .Column( 0 , i)

               'Ensure we have not done this already
               If ifTableExists(strTableName & "_" & tblname) = False Then
                  'Ensure the External table does indeed exist
                  If ifExternalTableExists(tblname, mpath) Then
                     'Import the MS Access Table
                     'Create the SQL Code from our String Values 
      strSql = "SELECT " & tblname & ".* INTO [" & strTableName & "_" &  tblname & _
                           "] FROM [" & tblname & "] IN '" & mpath & "'[MS ACCESS;];"

                     'Print the SQL for testing
                     Debug.Print strSql
                     Db.Execute strSql
                  End If
               End If
            Next i
         End With

      End If

   Next objF1

ExitHere:
   'close out
   Set objF1 = Nothing
   Set objFiles = Nothing
   Set objFolder = Nothing
   Set objFS = Nothing
   Db.Close
   Set Db = Nothing
   Exit Sub

errhandler:
   'Trap any errors
   With Err
      MsgBox "Error " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, "ImportMDB"
   End With

   Resume ExitHere
End Sub