谁有自动链接同目录下两个后端数据库的代码？

静儿

谁有自动链接同目录下两个后端数据库的代码？给我一个或给个链接，谢谢！

tmtony

这个可能需要你 先建立一个配置表，指明哪些表是对应一个后台数据库，哪些表对应另一个后台数据库
然后 将单个 刷新代码 里连接数据库的 分开两部分

todaynew

在系统表MSysObjects中有四个字段与此问题有关，即Database、ForeignName、Name、Type，可利用这三个字段来进行多后台的重联处理。

4楼的函数在Autoexec宏中用Runcode宏命令调用多次分别指定不同的后台文件即可。

todaynew

Function MyTrdb(Fpath As String, Fname As String)
'引用：Microsoft Scripting Runtime
'功能：重建表链接。
'参数：Fname：后台数据库完整文件名
'示例：MyTrdb(CurrentProject.Path & "\","后台.mdb")

Dim myFSO As New FileSystemObject
Dim obj As AccessObject, dbs As Object
Dim tbnmae As String, sname As String
Dim Dname As String
On Error GoTo MyTrdb_Err
     If myFSO.FileExists(Fpath & Fname) = True Then
         Set dbs = Application.CurrentData
         For Each obj In dbs.AllTables
             If InStr(obj.Name, "MSys") = 0 Then
                 If DLookup("Type", "MSysObjects", "name='" & obj.Name & "'") = 6 Then
                     Dname = Nz(DLookup("Database", "MSysObjects", "name='" & obj.Name & "'"), "")
                     If Fpath & Fname <> Dname Then
                         If Dname <> "" Then
                             If Mid(Dname, InStrRev(Dname, "\") + 1) = Fname Then
                                 tbnmae = obj.Name
                                 sname = DLookup("ForeignName", "MSysObjects", "name='" & obj.Name & "'")
                                 DoCmd.DeleteObject acTable, tbnmae                                                        '删除链接
                                 DoCmd.TransferDatabase acLink, "Microsoft Access", Fpath & Fname, acTable, sname, tbnmae, False  '建立链接
                             End If
                         End If
                     End If
                 End If
             End If
         Next obj
     
    End If
MyTrdb_Exit:
     Exit Function

MyTrdb_Err:
     MsgBox Error$
     Resume MyTrdb_Exit
End Function

静儿

试了一下，若链接表是子表就没法更改链接，是什么原因？

todaynew

静儿 发表于 2012-12-6 13:02
试了一下，若链接表是子表就没法更改链接，是什么原因？

可以呀

比如在后台1中加一个学校表，将年级表作为子表，链接一样正常。

静儿

找到原因了：由于MSysObjects表中存在两条 obj.Name 的记录时只取第一个记录就会出现一些链接表未更新的情况，以下代码加一个条件就可以了。
Dname = Nz(DLookup("[Database]", "MSysObjects", "[name]='" & obj.Name & "' and [type]=6 "), "")

todaynew

静儿 发表于 2012-12-6 16:04
找到原因了：由于MSysObjects表中存在两条 obj.Name 的记录时只取第一个记录就会出现一些链接表未更新的情况 ...

好运牛

谢谢 3楼 todaynew 分享