自动合并拆分ms访问数据库

时间:2013-04-17 08:50:11

标签: ms-access

在工作中,我们有一个拆分ms访问数据库。后端位于本地映射的驱动器上(因此对于每个人来说,它都是相同的路径)。我知道想要在前端创建一个按钮,当单击时自动创建数据库的合并版本。此版本是满足特定备份/历史记录需求所必需的。我对VBA编程知之甚少,所以感谢任何帮助。

要创建合并版本,代码应该只执行以下操作: 创建重复的前端(?) 删除副本中的所有现有表 将表从后端导入到副本

(我知道合并拆分数据库并不是一个好主意,但在这种情况下,许多用户完全不了解CS,这是最有用的解决方案)

1 个答案:

答案 0 :(得分:0)

使用以下函数

在前端数据库中创建模块
Public Function ImportLinkedTables()
Dim cdb As DAO.Database, tbd As DAO.TableDef
Dim tablesToLink As Collection, item As Variant, a() As String
Const LinkPrefix = ";DATABASE="
Set cdb = CurrentDb

Set tablesToLink = New Collection
For Each tbd In cdb.TableDefs
    If tbd.Connect Like (LinkPrefix & "*") Then
        '' tab-delimited list: TableDef name [tab] Source file [tab] Source table
        tablesToLink.Add tbd.Name & vbTab & Mid(tbd.Connect, Len(LinkPrefix) + 1) & vbTab & tbd.SourceTableName
    End If
Next
Set tbd = Nothing

For Each item In tablesToLink
    a = Split(item, vbTab, -1, vbBinaryCompare)
    DoCmd.DeleteObject acTable, a(0)
    Debug.Print "Importing [" & a(0) & "]"
    DoCmd.TransferDatabase acImport, "Microsoft Access", a(1), acTable, a(2), a(0), False
Next
Set tablesToLink = Nothing

Set cdb = Nothing
DoCmd.Quit
End Function

创建一个名为“ImportLinkedTables”的宏,只需一步:

RunCode
    Function Name  ImportLinkedTables()

启动流程的表单按钮后面的代码将是

Private Sub Command0_Click()
Dim fso As FileSystemObject
Dim wshShell As wshShell
Dim accdbName As String, command As String

Const SourceFolder = "Y:\_dev\"
Const DestFolder = "C:\Users\Gord\Desktop\"

accdbName = Application.CurrentProject.Name

'' copy front-end file to new location
Set fso = New FileSystemObject
fso.CopyFile SourceFolder & accdbName, DestFolder & accdbName, True
Set fso = Nothing

Set wshShell = New wshShell
command = """"
command = command & wshShell.RegRead("HKLM\Software\Microsoft\Office\" & Application.Version & "\Common\InstallRoot\Path")
command = command & "MSACCESS.EXE"" """ & DestFolder & accdbName & """ /x ImportLinkedTables"
wshShell.Run command, 7, False
Set wshShell = Nothing

End Sub