重新定位链接表二步走

尽管Accxp网上有很多关于定位链接表的贴子，但还是有很多的朋友询问这方面的问题。应letter网友的提议，结合Alex总版主的重新定位链接表文件源码，现将这方面的具体操作介绍如下： 

假设前台数据库文件名为frontBase.mdb 
后台数据库文件名为backData.mdb 
frontBase当中有链接表tbl1, tbl2, tbl3, …，链接到backData.mdb中 

首先我们要在前台数据库文件的启动窗体加载事件中判断链接是否正确

方法是打开任意一个链接表，假设为tbl1，代码如下： 

Public Function CheckLinks() As Boolean 
' 检查到后台数据库的链接；如果链接存在且正确的话，返回 True 。　　 
　　Dim dbs As Database, rst As DAO.Recordset　　 
　　Set dbs = CurrentDb() 
　　' 打开链接表查看表链接信息是否正确。 
　　On Error Resume Next 
　　Set rst = dbs.OpenRecordset(“tbl1”) 
　　rst.Close 
　　' 如果没有错误，返回 True 。 
　　If Err = 0 Then 
　　　　CheckLinks = True 
　　Else 
　　　　CheckLinks = False 
　　End If　　 
End Function 

启动窗体的加载事件： 
Private Sub FORM_Load() 
If CheckLinks = False then 
Docmd.OpenFORM “frmConnect” 
End If 
End Sub 

frmConnect 连接窗体如下图 

[img]f:\m.bmp[/img] 

接下来的事情就是如何刷新链接表了。 
上面的窗体右边的按钮是用用来调用API打开文件对话框，具体代码如下： 
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean 

Type OPENFILENAME 
　　lStructSize As Long 
　　hwndOwner As Long 
　　hInstance As Long 
　　lpstrFilter As String 
　　lpstrCustomFilter As String 
　　nMaxCustFilter As Long 
　　nFilterIndex As Long 
　　lpstrFile As String 
　　nMaxFile As Long 
　　lpstrFileTitle As String 
　　nMaxFileTitle As Long 
　　lpstrInitialDir As String 
　　lpstrTitle As String 
　　flags As Long 
　　nFileOffset As Integer 
　　nFileExtension As Integer 
　　lpstrDefExt As String 
　　lCustData As Long 
　　lpfnHook As Long 
　　lpTemplateName As String 
End Type 

Private Sub FileOpen_Click() 
　 Dim ofn As OPENFILENAME 
　 Dim rtn As String 

　 ofn.lStructSize = Len(ofn) 
　 ofn.hwndOwner = Me.hwnd 
　 
　 ofn.lpstrFilter = "数据库文件 (*.mdb)" & vbNullChar & "*.mdb" 
　 ofn.lpstrFile = Space(254) 
　 ofn.nMaxFile = 255 
　 ofn.lpstrFileTitle = Space(254) 
　 ofn.nMaxFileTitle = 255 
　 ofn.lpstrInitialDir = CurrentProject.Path 
　 ofn.lpstrTitle = "后台数据文件为" 
　 ofn.flags = 6148 

　 rtn = GetOpenFileName(ofn) 
　 
　 FileName.SetFocus 
　 If rtn = True Then 
　　　 FileName.Text = ofn.lpstrFile 
　　　 FileName.Text = FileName.Text 
　　　 OK.Enabled = True 
　 Else 
　　　 FileName.Text = "" 
　 End If 
End Sub 

连接按钮刷新链接表，代码如下： 
Private Sub OK_Click() 
Dim tabDef As TableDef 
For Each tabDef In CurrentDb.TableDefs 
If Len(tabDef.Connect) > 0 Then 
tabDef.Connect = ";DATABASE=" & Me.FileName.Text & ";PWD=" + 后台数据库密码 
tabDef.RefreshLink 
End If 
Next 
MsgBox "连接成功！" 
DoCmd.Close acFORM, Me.Name 
End Sub 

其实很简单只有两步，判断链接是否正确和刷新链接表。