刷新錶鏈接

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