重建后台数据库链接函数

todaynew

如大师们能把议论结果用代码贴出,则不失为一件功德之举!切盼!
zmt 发表于 2009-9-3 14:22

非大师，初学而已。我想代码大体可以如下：
Function MyURL(Fname As String)
'功能说明:重建表链接。
'参数：Fname：后台数据库完整文件名
'示例：MyTrdb(CurrentProject.Path & "\后台数据库.mdb")

Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long

ssql = "select * from MSysObjects where Type=6"
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

For i = 1 To rs.RecordCount
    if rs("Database") <> Fname then
          rs("Database") = Fname
          rs.Update
    end if
    rs.MoveNext
Next

End Function

如嫌记录集啰嗦的话，用更新查询也可。如下：

Function MyURLSQL(Fname As String)
'功能说明:重建表链接。
'参数：Fname：后台数据库完整文件名
'示例：MyTrdb(CurrentProject.Path & "\后台数据库.mdb")
Dim ssql As String
If Nz(DCount("*", "MSysObjects", "Type=6 and Database='" & Fname & "'"), 0) = 0 Then Exit Function
ssql = "UPDATE MSysObjects SET MSysObjects.[Database] = '" & Fname & "'"
ssql = ssql & " WHERE Type=6 AND Database<>'" & Fname & "'"
CurrentDb.Execute ssql
End Function

nncchh

学习了