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

会计考友

　用access做应用程序，往往做成"数据"和"程序"两个数据库，"数据"数据库中只存放数据表，"程序"数据库中存放所有的form，query,report,module等，通过表联接"程序"数据库可以访问所有"数据"数据库中的表。 　　当我们的应用程序更换存储位置的时候往往失去正确的表联接，造成运行错误。下面的一段程序可以自动找回表联接。在我的应用中"程序"数据库名字是stockMgr.mdb,"数据"数据库名字是stock-Data.mdb
9 M1 h0 L  M! H  L$ ]9 w; x　　注意： 该程序仅限于"程序"和"数据"存放在同一个目录而且是对应单个"数据"文件的情况。
　　Function ReAttachTable()
　　Dim MyDB As Database, MyTbl As TableDef
# M. m2 \( Q4 K4 y1 z$ S6 w& [　　Dim cpath As String
　　Dim datafiles As String, i As Integer
4 _1 |0 f- u8 s4 Z9 A$ V( F　　On Error Resume Next
' z/ x6 `- @: K8 [6 L; G. P/ _. I　　Set MyDB = CurrentDb
　　cpath = trimFileName(CurrentDb.Name)
　　datafiles = "stock-data.mdb"
; ~4 \+ A) v( `4 d( {　　DoCmd.Hourglass True
+ d0 r8 x+ k# j　　For i = 0 To MyDB.TableDefs.Count - 1
" y- O/ I' W1 L/ H/ u　　Set MyTbl = MyDB.TableDefs(i)
　　If MyTbl.Attributes = DB_ATTACHEDTABLE And Left(MyTbl.Connect, 1) = ";" Then
　　MyTbl.Connect = ";DATABASE=" %26amp; cpath %26amp; datafiles
7 z/ G0 r* O3 l. Y  \　　MyTbl.RefreshLink
9 o, f$ L: O7 s- q2 P4 [& K　　If Err Then
) O0 K* H. m1 H5 ?: T　　If vbNo = MsgBox(Err.description %26amp; "，继续吗？", vbYesNo) Then Exit For
* J4 @' |# |! W; N5 `/ B6 ]　　End If
0 q" M' h: O) d% X　　End If
+ a# h% I. F) i% j+ _　　Next i
　　DoCmd.Hourglass False
+ d9 B% ^7 A5 y1 `# P% r　　msgbox "Tables relink finish."
+ X5 s  e( K8 {- H　　End Function
　　'绝对路径中去掉文件名，返回路径
  N; V7 e$ M( H0 H. Y& V; h$ j　　Function trimFileName(fullname As String) As String
% x) Q( C' W8 _  Z! u　　Dim slen As Long, i As Long
' M8 e- t: w% h) T. K  l　　slen = Len(fullname)
. V) `$ |  ^' M8 A$ q　　For i = slen To 1 Step -1
0 w, c  W, j7 s' D0 c; m- [　　If Mid(fullname, i, 1) = "\" Then
  f; G; w3 Z% ?  w/ A: L4 I　　Exit For
　　End If
　　Next
　　trimFileName = Left(fullname, i)
　　End Function
　　在程序启动或者按钮动作中调用即可。