Office中国论坛/Access中国论坛

标题: 重建后台数据库链接函数 [打印本页]

作者: todaynew 时间: 2009-9-2 11:06
标题: 重建后台数据库链接函数
本帖最后由 todaynew 于 2009-9-2 12:02 编辑

'重建后台数据库链接函数
Function MyTrdb(Fname As String)
'功能：重建表链接。
'参数：Fname：后台数据库完整文件名
'示例：MyTrdb(CurrentProject.Path & "\后台数据库.mdb")
Dim obj As AccessObject, dbs As Object
Dim tbnmae As String
On Error GoTo MyTrdb_Err

Set dbs = Application.CurrentData
For Each obj In dbs.AllTables
      tbnmae = obj.Name
      If InStr(obj.Name, "MSys") = 0 Then
         DoCmd.DeleteObject acTable, _
bnmae                                                       '删除链接
         DoCmd.TransferDatabase acLink, "Microsoft Access", _
Fname, acTable, tbnmae, tbnmae, False       '建立链接
      End If
Next obj
MyTrdb_Exit:
Exit Function
MyTrdb_Err:
MsgBox Error$
Resume MyTrdb_Exit
End Function

作者: koutx 时间: 2009-9-2 11:12
收了.不错.

作者: aslxt 时间: 2009-9-2 11:16
谢谢分享，看起来好像不止删除链接表，而是删除用户表。啊？
If InStr(obj.Name, "MSys") = 0 Then
DoCmd.DeleteObject acTable, tbnmae '删除链接
DoCmd.TransferDatabase acLink, "Microsoft Access", Fname, acTable, tbnmae, tbnmae, False '建立链接
End If

作者: todaynew 时间: 2009-9-2 11:55
本帖最后由 todaynew 于 2009-9-2 12:04 编辑

谢谢分享，看起来好像不止删除链接表，而是删除用户表。啊？
If InStr(obj.Name, "MSys") = 0 Then
DoCmd.DeleteObject acTable, tbnmae '删除链接
D ...
aslxt 发表于 2009-9-2 11:16

不会吧？如果前台还有用户表的话，加if排除即可。

作者: aslxt 时间: 2009-9-2 12:42
4# todaynew
是啊，有一些程序在前台还有用户表。当然是可以排除的。我的意思是你的标题看起来是重新链接后台表，而实际是删除用户表-再链接后台表而已。

作者: todaynew 时间: 2009-9-2 16:42

4# todaynew
是啊，有一些程序在前台还有用户表。当然是可以排除的。我的意思是你的标题看起来是重新链接后台表，而实际是删除用户表-再链接后台表而已。
aslxt 发表于 2009-9-2 12:42

有道理
是否可以通过表的属性(Type之流)来进行排除呢？

作者: aslxt 时间: 2009-9-2 16:55
可以通过MSysObjects表的database字段来排除。如果是本地表，该字段为空值，他记录的是链接表的mdb文件路径，还可以选择性地删除某个后台的链接而保留其他后台的链接

作者: fnsmydyang 时间: 2009-9-2 23:03
精彩问答，收藏了，谢谢

作者: todaynew 时间: 2009-9-3 14:10
本帖最后由 todaynew 于 2009-9-3 14:12 编辑

可以通过MSysObjects表的database字段来排除。如果是本地表，该字段为空值，他记录的是链接表的mdb文件路径，还可以选择性地删除某个后台的链接而保留其他后台的链接
aslxt 发表于 2009-9-2 16:55

很好的建议！
由此来看，不如遍历MSysObjects表，直接修改其地址，以此解决问题更为简单。
谢谢aslxt同志指点！

作者: todaynew 时间: 2009-9-3 15:26
本帖最后由 todaynew 于 2009-9-3 16:47 编辑

如大师们能把议论结果用代码贴出,则不失为一件功德之举!切盼!
zmt 发表于 2009-9-3 14:22

非大师，初学而已。我想代码大体可以如下：
Function MyURL(Fname As String)
'功能说明:重建表链接。
'参数：Fname：后台数据库完整文件名
'示例：MyTrdb(CurrentProject.Path & "\后台数据库.mdb")

Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long

ssql = "select * from MSysObjects where Type=6"
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

For i = 1 To rs.RecordCount
if rs("Database") <> Fname then
rs("Database") = Fname
rs.Update
end if
rs.MoveNext
Next

End Function

如嫌记录集啰嗦的话，用更新查询也可。如下：

Function MyURLSQL(Fname As String)
'功能说明:重建表链接。
'参数：Fname：后台数据库完整文件名
'示例：MyTrdb(CurrentProject.Path & "\后台数据库.mdb")
Dim ssql As String
If Nz(DCount("*", "MSysObjects", "Type=6 and Database='" & Fname & "'"), 0) = 0 Then Exit Function
ssql = "UPDATE MSysObjects SET MSysObjects.[Database] = '" & Fname & "'"
ssql = ssql & " WHERE Type=6 AND Database<>'" & Fname & "'"
CurrentDb.Execute ssql
End Function

作者: nncchh 时间: 2015-5-25 23:00
学习了

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)