Question

我在浏览Web时发现了以下功能，允许我在执行时动态地将表链接到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

刷新表链接

1 个答案: