Access中的鏈接表

Question

我有一個連接到6個表的訪問數據庫。這些表格每週更新一次並保存在包含日期的文件夾中。我希望我的訪問程序要求用戶選擇沒有特別使用鏈接表管理器的表的位置。

Answer 1

以下代碼將提示用戶輸入要鏈接的數據庫的完整路徑和文件名。我決定這樣做，而不是隻提示一個文件夾。我強烈建議你看看連接字符串爲您的鏈接表之一，並確保沒有其他參數指定了像「等; DATABASE = C：\ Foldera \ YYMMDD \ MyAccessDB.mdb」

Private Function ReLinkTables() 
Dim dbs    As DAO.Database 
Dim tdf    As DAO.TableDef 
Dim tdf2   As DAO.TableDef 
Dim strConn   As String 
Dim strNewPath  As String 
Dim strTableName As String 

    On Error GoTo ERROR_HANDLER 

    ' Prompt user for new path... 
    strNewPath = GetFolder 

    ' Exit if none 
    If strNewPath = "" Then 
     Exit Function 
    End If 

    Set dbs = CurrentDb 
    dbs.TableDefs.Refresh 
    ' Find all the linked tables... 
    For Each tdf In dbs.TableDefs 
     'Debug.Print tdf.Name & vbTab & tdf.Connect 
     If Len(tdf.Connect) > 0 Then 
      strTableName = tdf.Name 
      Debug.Print "Linked Table: " & tdf.Name & vbTab & tdf.Connect 

      dbs.TableDefs.Delete strTableName   ' Delete the linked table 

      strConn = ";DATABASE=" & strNewPath 
      Set tdf2 = CurrentDb.CreateTableDef(strTableName, dbAttachSavePWD, strTableName, strConn) 
      CurrentDb.TableDefs.Append tdf2 
     Else  ' Not a linked table 
      'Debug.Print "Keep: " & tdf.Name & vbTab & tdf.Connect 
     End If 
    Next tdf 

    Set tdf = Nothing 
    Set tdf2 = Nothing 
    dbs.TableDefs.Refresh 
    dbs.Close 
    Set dbs = Nothing 
    MsgBox "Finished Relinking Tables" 
Proc_Exit: 

    Exit Function 

ERROR_HANDLER: 
    Debug.Print Err.Number & vbTab & Err.Description 
    Err.Source = "Module_Load_SQLSERVER_DATABASE: ReLinkTables at Line: " & Erl 
    If Err.Number = 9999 Then 
     Resume Next 
    End If 
    MsgBox Err.Number & vbCrLf & Err.Description 
    Resume Proc_Exit 
    Resume Next 
End Function 

Function GetFolder() As String 
    Dim fldr As FileDialog 
    Dim sItem As String 
    Set fldr = Application.FileDialog(msoFileDialogFilePicker) 
    With fldr 
     .Title = "Select a Folder" 
     .AllowMultiSelect = False 
     '.InitialFileName = "Z:\xxxxxxxx"   ' You can change to valid start path 
     If .Show <> -1 Then GoTo NextCode 
     sItem = .SelectedItems(1) 
    End With 
NextCode: 
    Debug.Print "User selected path: >" & sItem & "<" 
    If sItem = "" Then MsgBox "User did not select a path.", vbOKOnly, "No Path" 
    GetFolder = sItem 
    Set fldr = Nothing 
End Function