MS Access - Создать таблицу - Системные таблицы

Question

Сценарий: 1. Доступ к базе данных, связанной со связанными таблицами 2. Вторая база данных Access для получения новых таблиц на основе структуры связанных таблиц в первой базе данных. 3. Код выглядит так:

    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

Код выполняется до первой таблицы MSys, когда он пытается создать предыдущую таблицу. Это, очевидно, приводит к ошибке: таблица уже существует ..

Я не могу понять, почему он игнорирует условие в операторе If и выдает ошибку.

Answer 1

dbtemp.TableDefs.Append tblNew находится вне блока If..End If.Поэтому ваш код будет пытаться выполнить эту строку каждый раз через внешний цикл For ... независимо от того, начинается ли текущее имя tblSrc.Name с "MSys".процедура.

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

Answer 2

Измените свой код с

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

К

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

У меня была такая же проблема, и, изменив ее на вышеприведенную, она работала для меня.

Я использую следующее для объединения двух БД доступа в одну копию.

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