Office中国论坛/Access中国论坛

标题: 一个事件发生的时机求助 [打印本页]

作者: lkkl66 时间: 2011-2-28 21:25
标题: 一个事件发生的时机求助
问题：如下图：

作者: roych 时间: 2011-3-1 10:08
选中链接表（任意一个），右击，“链接表管理器”，重新刷新链接位置就好了，如图所示：
[attach]44945[/attach]

作者: lkkl66 时间: 2011-3-1 10:50
怎样用《VBA》语句来进行控制？

作者: todaynew 时间: 2011-3-1 12:40
本帖最后由 todaynew 于 2011-3-1 12:43 编辑

lkkl66 发表于 2011-2-28 21:25
问题：如下图：

可在Autoexec宏中用RunCode操作调用以下函数：

Function MyTrdb(Fpath As String, Fname As String)
'引用：Microsoft Scripting Runtime
'功能：重建表链接。
'参数：Fname：后台数据库完整文件名
'示例：MyTrdb(CurrentProject.Path & "\","后台.mdb")

Dim myFSO As New FileSystemObject
Dim obj As AccessObject, dbs As Object
Dim tbnmae As String, sname As String
Dim Dname As String
On Error GoTo MyTrdb_Err
If myFSO.FileExists(Fpath & Fname) = True Then
      Set dbs = Application.CurrentData
      For Each obj In dbs.AllTables
         If InStr(obj.Name, "MSys") = 0 Then
            If DLookup("Type", "MSysObjects", "name='" & obj.Name & "'") = 6 Then
                  Dname = Nz(DLookup("Database", "MSysObjects", "name='" & obj.Name & "'"), "")
                  If Fpath & Fname <> Dname Then
                     If Dname <> "" Then
                        If Mid(Dname, InStrRev(Dname, "\") + 1) = Fname Then
                              tbnmae = obj.Name
                              sname = DLookup("ForeignName", "MSysObjects", "name='" & obj.Name & "'")
                              DoCmd.DeleteObject acTable, tbnmae                                                       '删除链接
                              DoCmd.TransferDatabase acLink, "Microsoft Access", Fpath & Fname, acTable, sname, tbnmae, False  '建立链接
                        End If
                     End If
                  End If
            End If
         End If
      Next obj

End If
MyTrdb_Exit:
Exit Function

MyTrdb_Err:
MsgBox Error$
Resume MyTrdb_Exit
End Function

作者: lkkl66 时间: 2011-3-3 07:54
谢谢！还是感谢！

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)