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
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
