Public Function fnCopyTables() On Error GoTo fnCopyTables_ErrorRoutine 'http://support.microsoft.com/kb/298174 Dim db As Database 'Database to import Dim tdf As TableDef Dim sTablename As String Dim sPath As String sPath = fnFileDialog Set db = DBEngine.Workspaces(0).OpenDatabase(sPath, True) For Each tdf In db.TableDefs sTablename = tdf.Name Debug.Print sTablename If Left(sTablename, 4) <> "MSys" Then DoCmd.TransferDatabase _ acImport, "Microsoft Access", sPath, acTable, sTablename, sTablename, False End If fnCopyTables_Resume_3044: Next fnCopyTables_Exit: Exit Function fnCopyTables_ErrorRoutine: Select Case Err.Number Case 3044 ' 3044 blah is not a valid path ' Do not copy bad links ' This database needs to be able to see the same as the target database so it can check links MsgBox "** Bad Link : " & sTablename & " - Path - " & tdf.Connect Resume fnCopyTables_Resume_3044 Case Else MsgBox "** Error Number : " & Err.Number & vbCrLf & Err.Description, , "Error message" Resume fnCopyTables_Exit End Select End Function |