刷新表格链接

Question

我在浏览网页时发现了以下函数，它允许我在执行时将表动态链接到我的 Access 数据库：

Function createAttached(strTable As String, strPath As String, strBaseTable As String) As Boolean

'************************************************************************************
'* Create an attached table in the current database from a table in a different MDB file.
'* In:                                                                              *
'*   strTable - name of linked table to create                                      *
'*   strPath - path and name of MDB file containing the table                       *
'*   strBaseTable - name of table in strPath MDB                                    *
'* Out:                                                                             *
'*   Return value: True/False, indicating success                                   *
'* Modifies:                                                                        *
'*   Nothing, but adds a new table.                                                 *
'************************************************************************************

On Error GoTo CreateAttachedError

Dim tdf As TableDef
Dim strConnect As String
Dim fRetval As Boolean
Dim myDB As Database

    DoCmd.SetWarnings False
    Set myDB = CurrentDb
    Set tdf = myDB.CreateTableDef(strTable)

    With tdf
        .Connect = ";DATABASE=" & strPath
        .SourceTableName = strBaseTable
    End With

    myDB.TableDefs.Append tdf

    fRetval = True

    DoCmd.SetWarnings True

CreateAttachedExit:
    createAttached = fRetval
    Exit Function

CreateAttachedError:
    If Err = 3110 Then
        Resume CreateAttachedExit
    Else
        If Err = 3011 Then
            Resume Next
        End If
    End If

End Function

这个脚本可以工作，但是，如果表已经链接，它什么也不做（但仍然会触发错误事件）。如果链接表存在，我希望使用相同的脚本删除链接表，或者至少刷新该链接以使路径正确。我不知道该怎么做，可能很简单，但我不知道从哪里开始。

谢谢。

Answer 1

这是我使用的。它还在尝试刷新链接之前测试表是否为链接表。 此代码假定您要链接的数据库与您要链接的数据库位于同一文件夹中。如果没有，请删除“Application.CurrentProject.Path”并添加适当的路径。

Public Sub RelinkTables()
    Dim dbs As Database
    Dim Tdf As TableDef
    Dim Tdfs As TableDefs
    Set dbs = CurrentDb
    Set Tdfs = dbs.TableDefs
    For Each Tdf In Tdfs
        If Tdf.SourceTableName <> "" Then 'If the table source is other than a base table
            Tdf.Connect = ";DATABASE=" & Application.CurrentProject.Path & "\filename.accdb" 'Set the new source
            Tdf.RefreshLink 'Refresh the link
        End If
    Next 'Goto next table
End Sub