Hi Allen

Code is:

Sub subCreateNewTable()
Dim dbNew As Database                                       ' The new
database object
   
   Set ws = DBEngine.Workspaces(0)                         ' Create workspace
   strNewTables = Forms!frmUpgrade.txtPath & "PA5_Data_Tables.mdb"        '
The file to export to
     
   If Dir(strNewTables) <> "" Then                         'Make sure there
isn't already a file with that name
           Kill strNewTables
   End If
   
   Set dbNew = ws.CreateDatabase(strNewTables, dbLangGeneral)      ' Create
the database
   
   ' Identify records to export
   Set dbs = CurrentDb                                      ' Nominate the
database
   strSQL = "SELECT DISTINCT MSysObjects.Name, MSysObjects.Type " & _
               "FROM MSysObjects " & _
               "WHERE (((MSysObjects.Name) Not Like ""msys*"") AND
((MSysObjects.Type)=1));"
   Set rst = dbs.OpenRecordset(strSQL)                     ' Recordset of
table names
   
   Do While Not rst.EOF                                    ' Export each
table (rst!Name is the table name)
   
       If Left(rst!Name, 1) = "t" Then                     ' Only export
tables starting with tbl....
           subDisplayProgress "Exporting " & (rst!Name) & _
               " to PA5_Data_Tables.mdb"                       ' Display
progress
   
           DoCmd.TransferDatabase acExport, "Microsoft Access", _
                   strNewTables, acTable, rst!Name, rst!Name, False
       End If
       rst.MoveNext
   
   Loop
   
       subHideProgress                                     ' Hide the
progress label
   
       Set dbs = Nothing                                   ' Clean up
       Set dbsNew = Nothing
       Set rst = Nothing

End Sub