access中数据表的自动重新联接

最大的网站源码资源下载站，

当我们的应用程序更换存储位置的时候往往失去正确的表联接，造成运行错误。下面的一段程序可以自动找回表联接。在我的应用中"程序"数据库名字是stockmgr.mdb,"数据"数据库名字是stock-data.mdb
注意： 该程序仅限于"程序"和"数据"存放在同一个目录而且是对应单个"数据"文件的情况。

function reattachtable()
dim mydb as database, mytbl as tabledef
dim cpath as string
dim datafiles as string, i as integer

on error resume next
set mydb = currentdb
cpath = trimfilename(currentdb.name)
datafiles = "stock-data.mdb"
docmd.hourglass true
for i = 0 to mydb.tabledefs.count - 1
set mytbl = mydb.tabledefs(i)
if mytbl.attributes = db_attachedtable and left(mytbl.connect, 1) = ";" then
mytbl.connect = ";database=" & cpath & datafiles
mytbl.refreshlink
if err then
if vbno = msgbox(err.description & "，继续吗？", vbyesno) then exit for
end if
end if
next i
docmd.hourglass false
msgbox "tables relink finish."
end function

'绝对路径中去掉文件名，返回路径
function trimfilename(fullname as string) as string
dim slen as long, i as long
slen = len(fullname)
for i = slen to 1 step -1
if mid(fullname, i, 1) = "/" then
exit for
end if
next
trimfilename = left(fullname, i)
end function

在程序启动或者按钮动作中调用即可。