MS Access - Create Table - System Tables

Scenario: 1. Access database containg linked tables 2开发者_开发问答. Second Access database to receive new tables based on structure of linked tables in 1st database 3. Code looks like this:

    Dim db As Database
    Dim dbtemp As Database
    Dim tblSrc As TableDef
    Dim tblNew As TableDef
    Dim fldSrc As Field
    Dim fldNew As Field

    Set db = CurrentDb()
    Set dbtemp = OpenDatabase("C:\MSR DWA\CACHE\CacheTemp.mdb")

    For Each tblSrc In db.TableDefs
        If Not Left(tblSrc.Name, 4) = "MSys" Then
'Debug.Print tblSrc.Name
            Set tblNew = dbtemp.CreateTableDef(tblSrc.Name)
            For Each fldSrc In tblSrc.Fields
                Set fldNew = tblNew.CreateField(fldSrc.Name, fldSrc.Type, fldSrc.Size)
                On Error Resume Next
                fldNew.Attributes = fldSrc.Attributes
                fldNew.AllowZeroLength = fldSrc.AllowZeroLength
                fldNew.DefaultValue = fldSrc.DefaultValue
                fldNew.Required = fldSrc.Required
                fldNew.Size = fldSrc.Size
                tblNew.Fields.Append fldNew
                On Error GoTo 0
            Next
        End If
        dbtemp.TableDefs.Append tblNew
    Next

Code runs until the first MSys table is encountered when it tries to create the previous table. This obviously results in error: table already exists..

I can't figure out why it seems to be ignoring the condition in the If statement and erroring out.

dbtemp.TableDefs.Append tblNew is outside the If..End If block. Therefore your code will attempt to execute that line each time through the outer For loop ... whether or not the current tblSrc.Name starts with "MSys".

It's clearer when you strip away most of the procedure.

For Each tblSrc In db.TableDefs
    If Not Left(tblSrc.name, 4) = "MSys" Then
    End If
    dbtemp.TableDefs.Append tblNew
Next

Change your code from

If Not Left(tblSrc.Name, 4) = "MSys" Then

To

If Left(tblSrc.Name, 4) <> "MSys" Then

I had this same problem and by changing it to the above it worked for me.

I use the following to combine two Access Dbs into one copy.

Public Sub CombineDBs()
    Dim appAccess As New Access.Application     'define the copy of the database to transfer to

    Dim db As Database 'Database to import
    Dim td As TableDef 'Tabledefs in db
    Dim strTDef As String 'Name of table or query to import
    Dim Const cDir_Database         As String = "Location1" 'Access Location

    appAccess.Visible = False

    'opens the database that needs the tables and data added to it
    appAccess.OpenCurrentDatabase "location"

    'opens the database to import data from
    Set db = OpenDatabase(cDir_Database)

    'Import tables from specified Access database.
    For Each td In db.TableDefs

    strTDef = td.Name

    If Left(strTDef, 4) <> "MSys" Then
        appAccess.DoCmd.TransferDatabase acImport, "Microsoft Access", cDir_Database, acTable, strTDef, strTDef, False
    End If

    Next

    appAccess.CloseCurrentDatabase
    db.Close

End Sub