其他数据库中所有对象导入到当前数据库

时　间:2008-01-17 00:26:07
作　者:微软   ID：8  城市：上海  QQ：2851379730
摘　要:其他数据库中所有对象导入到当前数据库
正　文:

要其他数据库中所有对象导入到当前数据库, 请按照下列步骤操作：

1. 启动 Access, 并打开其中想要导入对象数据库。这可能是一个空数据库。
2. 在数据库窗口, 模块 , 单击， 然后单击 新建 。
3. 在 工具 菜单上, 单击 引用 。 确保 Microsoft DAO 3.6 对象库 ， 或以后的引用列表中选中。 还要确保未选中任何引用到 MicrosoftActiveX 数据对象。 单击 确定 。
4. 键入或粘贴以下代码模块窗口中：

Public Function ImportDb(strPath As String) As Boolean

    On Error Resume Next

    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 qd As QueryDef    'Querydefs in db
    Dim doc As Document    'Documents in db
    Dim strCntName As String    'Document container name
    Dim x As Integer    'For looping
    Dim cntContainer As Container    'Containers in db
    Dim strDocName As String    'Name of document
    Dim intConst As Integer
    Dim cdb As Database    'Current Database
    Dim rel As Relation    'Relation to copy
    Dim nrel As Relation    'Relation to create
    Dim strRName As String    'Copied relation's name
    Dim strTName As String    'Relation Table name
    Dim strFTName As String    'Relation Foreign Table name
    Dim varAtt As Variant    'Attributes of relation
    Dim fld As Field    'Field(s) in relation to copy
    Dim strFName As String    'Name of field to append
    Dim strFFName As String    'Foreign name of field to append

    'Open database which contains objects to import.

    Set db = DBEngine.Workspaces(0).OpenDatabase(strPath, True)

    'Import tables from specified Access database.

    For Each td In db.TableDefs

        strTDef = td.Name

        If Left(strTDef, 4) <> "MSys" Then

            DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, _
                                   strTDef, strTDef, False

        End If

    Next

    'Import queries.

    For Each qd In db.QueryDefs

        strTDef = qd.Name

        DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acQuery, _
                               strTDef, strTDef, False

    Next

    'Copy relationships to current database.

    Set cdb = CurrentDb

    For Each rel In db.Relations

        With rel

            'Get properties of relation to copy.

    &nb

Access软件网QQ交流群 (群号:54525238) 　　　　　　Access源码网店