Verknüpfen von Tabellen in Access

Question

Ich habe eine Access-Datenbank, die zu 6 Tabellen verknüpft. Diese Tabellen werden wöchentlich aktualisiert und in einem Ordner mit dem Datum aufbewahrt. Ich möchte, dass mein Zugriffsprogramm den Benutzer auffordert, den Speicherort der Tabellen auszuwählen, ohne den Linked Table Manager zu verwenden.

Answer 1

Der folgende Code fordert einen Benutzer auf, den vollständigen Pfad und den Dateinamen der Datenbank anzugeben, mit der er verknüpft werden soll. Ich beschloss, dies zu tun, anstatt nur nach einem Ordner zu fragen. Empfehle ich Ihnen bei der Verbindungszeichenfolge sucht eine Ihrer verknüpften Tabellen und stellen Sie sicher, dass keine anderen Parameter werden andere angegeben als so etwas wie ‚; 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