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
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