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

我遇到了同样的问题，通过将其改为上面的问题，它对我有用。

我使用以下内容将两个Access Dbs合并为一个副本。

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

MS Access - 创建表 - 系统表

2 个答案: