Public Function ReLink(ByVal strName As String, ByVal strPath As String, ByVal strPWD, ByVal id As Integer) As Boolean
Dim dbs As Database
Dim tdf As TableDef, i As Variant
On Error GoTo ErrorHandler
ReLink = False
Set dbs = CurrentDb
For Each i In Application.CurrentData.AllTables '历遍的有表
If DCount("*", "MSysObjects", "[Name]='" & i.Name & "' And [Type]=6") > 0 Then
'判断只有链接表才运行以下代码
strName = i.Name
Set tdf = dbs.TableDefs(strName)
tdf.Connect = "WD=" & strPWD & ";database=" & strPath
tdf.RefreshLink
End If
Next i
ReLink = True
Exit Function
ErrorHandler: ' 错误处理程序。
MsgBox "刷新失败!" & vbCr & vbCr & "失败原因 :" & vbCr & vbCr & _
"错误代码 : " & Err.Number & vbCr & _
"错误描述 : " & Err.Description, _
vbCritical
End Function
[此贴子已经被作者于2006-6-25 20:54:08编辑过]
|