Przechowywanie tabel połączonych dla dostępu do baz danych w tym samym folderze po zmianie folderu

Question

Mam dwie bazy danych programu Access, które udostępniają połączone tabele. Są one rozmieszczane razem w katalogu i dostępne za pośrednictwem kodu w postaci Word.

Jak mogę się upewnić, że łącza są zachowane, gdy dwie bazy danych zostaną skopiowane (razem) do innego folderu? Ponieważ nie "otwieram" bazy danych per se (dostęp do niej za pośrednictwem ADO), nie wiem, jak napisać kod, aby odświeżyć linki.

Answer 1

Aktualizacja 14APR2009 okazało się, że poprzednia odpowiedź dałem tutaj było błędne, więc zaktualizowałem go z nowym kodem.

Jak postępować

• Skopiuj poniższy kod do modułu VBA.

• z kodu lub z bezpośrednim okna w VBA IDE , wystarczy wpisać:

  RefreshLinksToPath Application.CurrentProject.Path 
  

To będzie teraz ponownie połączyć wszystkie tabele połączone do korzystania z katalogu, w którym znajduje się aplikacja.
Tę czynność należy wykonać tylko raz lub w przypadku ponownego łączenia lub dodawania nowych tabel.
Polecam robić to z kodu przy każdym uruchomieniu aplikacji.
Następnie można bez problemu przenosić bazy danych.

Kod

'------------------------------------------------------------' 
' Reconnect all linked tables using the given path.   ' 
' This only needs to be done once after the physical backend ' 
' has been moved to another location to correctly link to ' 
' the moved tables again.         ' 
' If the OnlyForTablesMatching parameter is given, then  ' 
' each table name is tested against the LIKE operator for a ' 
' possible match to this parameter.       ' 
' Only matching tables would be changed.      ' 
' For instance:            ' 
' RefreshLinksToPath(CurrentProject.Path, "local*")   ' 
' Would force all tables whose ane starts with 'local' to be ' 
' relinked to the current application directory.    ' 
'------------------------------------------------------------' 
Public Function RefreshLinksToPath(strNewPath As String, _ 
    Optional OnlyForTablesMatching As String = "*") As Boolean 

    Dim collTbls As New Collection 
    Dim i As Integer 
    Dim strDBPath As String 
    Dim strTbl As String 
    Dim strMsg As String 
    Dim strDBName As String 
    Dim strcon As String 
    Dim dbCurr As DAO.Database 
    Dim dbLink As DAO.Database 
    Dim tdf As TableDef 

    Set dbCurr = CurrentDb 

    On Local Error GoTo fRefreshLinks_Err 

    'First get all linked tables in a collection' 
    dbCurr.TableDefs.Refresh 
    For Each tdf In dbCurr.TableDefs 
     With tdf 
      If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = TableDefAttributeEnum.dbAttachedTable) _ 
       And (.Name Like OnlyForTablesMatching) Then 
       collTbls.Add Item:=.Name & .Connect, key:=.Name 
      End If 
     End With 
    Next 
    Set tdf = Nothing 

    ' Now link all of them' 
    For i = collTbls.count To 1 Step -1 
     strcon = collTbls(i) 
     ' Get the original name of the linked table ' 
     strDBPath = Right(strcon, Len(strcon) - (InStr(1, strcon, "DATABASE=") + 8)) 
     ' Get table name from connection string ' 
     strTbl = Left$(strcon, InStr(1, strcon, ";") - 1) 
     ' Get the name of the linked database ' 
     strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\")) 

     ' Reconstruct the full database path with the given path ' 
     strDBPath = strNewPath & "\" & strDBName 

     ' Reconnect ' 
     Set tdf = dbCurr.TableDefs(strTbl) 
     With tdf 
      .Connect = ";Database=" & strDBPath 
      .RefreshLink 
      collTbls.Remove (.Name) 
     End With 
    Next 
    RefreshLinksToPath = True 

fRefreshLinks_End: 
    Set collTbls = Nothing 
    Set tdf = Nothing 
    Set dbLink = Nothing 
    Set dbCurr = Nothing 
    Exit Function 

fRefreshLinks_Err: 
    RefreshLinksToPath = False 
    Select Case Err 
     Case 3059: 

     Case Else: 
      strMsg = "Error Information..." & vbCrLf & vbCrLf 
      strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf 
      strMsg = strMsg & "Description: " & Err.Description & vbCrLf 
      strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf 
      MsgBox strMsg 
      Resume fRefreshLinks_End 
    End Select 
End Function 

Kod ten jest dostosowany z tego źródła: http://www.mvps.org/access/tables/tbl0009.htm.
Usunąłem całą zależność od innych funkcji, aby było ono niezależne, dlatego jest nieco dłuższe niż powinno.

Answer 2

Czy odnosisz się do aktualizacji linków w formularzu Worda lub połączonych łączach tabeli między bazami danych programu Access?

Dla pierwszego z nich najlepiej jest zachować ciągi połączeń na poziomie modułu w dokumencie Word/projekcie VBA i utworzyć ciąg stałych. Następnie ustawiając ciąg połączenia dla obiektów ADO Connection, przekaż mu relatywny ciąg znaków połączenia.

Dla tego ostatniego, byłbym skłonny użyć względnej ścieżki w łańcuchu połączenia do danych w każdej bazie danych programu Access do drugiej. Na przykład,

Dim connectionString as String 

connectionString = ";DATABASE=" & CurrentProject.Path & "\[Database Name Here].mdb" 

jeśli tak można powiedzieć, czy bazy danych są kopiowane razem do innego folderu (jestem zakładając w tym samym folderze).

Answer 3

Odpowiedź Renaud nie działa już w programie Access 2010 z plikami Excel lub CSV.

zrobiłem kilka modyfikacji:

• dostosowany do aktualnego wzoru na ciąg połączenia
• obsługiwane ścieżka baza inaczej dla plików Excel (w tym nazwa pliku) i plików CSV (nie zawiera nazwy pliku)

Oto kod:

Public Function RefreshLinksToPath(strNewPath As String, _ 
Optional OnlyForTablesMatching As String = "*") As Boolean 

Dim collTbls As New Collection 
Dim i As Integer 
Dim strDBPath As String 
Dim strTbl As String 
Dim strMsg As String 
Dim strDBName As String 
Dim strcon As String 
Dim dbCurr As DAO.Database 
Dim dbLink As DAO.Database 
Dim tdf As TableDef 

Set dbCurr = CurrentDb 

On Local Error GoTo fRefreshLinks_Err 

'First get all linked tables in a collection' 
dbCurr.TableDefs.Refresh 
For Each tdf In dbCurr.TableDefs 
    With tdf 
     If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = _ 
      TableDefAttributeEnum.dbAttachedTable) _ 
      And (.Name Like OnlyForTablesMatching) Then 
      Debug.Print "Name: " & .Name 
      Debug.Print "Connect: " & .Connect 
      collTbls.Add Item:=.Name & ";" & .Connect, Key:=.Name 
     End If 
    End With 
Next 
Set tdf = Nothing 

' Now link all of them' 
For i = collTbls.Count To 1 Step -1 
    strConnRaw = collTbls(i) 
    ' Get table name from the full connection string 
    strTbl = Left$(strConnRaw, InStr(1, strConnRaw, ";") - 1) 
    ' Get original database path 
    strDBPath = Right(strConnRaw, Len(strConnRaw) - (InStr(1, strConnRaw, "DATABASE=") + 8)) 
    ' Get the name of the linked database 
    strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\")) 
    ' Get remainder of connection string 
    strConn = Mid(strConnRaw, InStr(1, strConnRaw, ";") + 1, InStr(1, strConnRaw, "DATABASE=") _ 
       - InStr(1, strConnRaw, ";") - 1) 

    ' Reconstruct the full database path with the given path 
    ' CSV-Files are not linked with their name! 
    If Left(strConn, 4) = "Text" Then 
     strDBPath = strNewPath 
    Else 
     strDBPath = strNewPath & "\" & strDBName 
    End If 

    ' Reconnect ' 
    Set tdf = dbCurr.TableDefs(strTbl) 
    With tdf 
     .Connect = strConn & "Database=" & strDBPath 
     .RefreshLink 
     collTbls.Remove (.Name) 
    End With 
Next 
RefreshLinksToPath = True 

fRefreshLinks_End: 
    Set collTbls = Nothing 
    Set tdf = Nothing 
    Set dbLink = Nothing 
    Set dbCurr = Nothing 
    Exit Function 

fRefreshLinks_Err: 
    RefreshLinksToPath = False 
    Select Case Err 
     Case 3059: 

     Case Else: 
      strMsg = "Error Information..." & vbCrLf & vbCrLf 
      strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf 
      strMsg = strMsg & "Description: " & Err.Description & vbCrLf 
      strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf 
      MsgBox strMsg 
      Resume fRefreshLinks_End 
    End Select 
End Function 

Answer 4

I niestety nadal jestem w Access 2007. Zacząłem od jednego z powyższych bloków kodu, który nie działał dla mnie. Mając mniej dostępu do mocy vba, uprościłem ją tylko do pierwszej pętli, która pobiera ścieżki tabeli i aktualizuje ją w miejscu. Następny facet, który się na to natknie, może komentować lub aktualizować.

Opcja Porównaj Database

'------------------------------------------------------------' 
' Reconnect all linked tables using the given path.   ' 
' This only needs to be done once after the physical backend ' 
' has been moved to another location to correctly link to ' 
' the moved tables again.         ' 
' If the OnlyForTablesMatching parameter is given, then  ' 
' each table name is tested against the LIKE operator for a ' 
' possible match to this parameter.       ' 
' Only matching tables would be changed.      ' 
' For instance:            ' 
' RefreshLinksToPath(CurrentProject.Path, "local*")   ' 
' Would force all tables whose ane starts with 'local' to be ' 
' relinked to the current application directory.    ' 
' 
' Immediate window type 
' RefreshLinksToPath Application.CurrentProject.Path 

'------------------------------------------------------------' 
Public Function RefreshLinksToPath(strNewPath As String, _ 
    Optional OnlyForTablesMatching As String = "*") As Boolean 

    Dim strDBPath As String 
    'Dim strTbl As String 
    'Dim strMsg As String 
    Dim strDBName As String 
    Dim dbCurr As DAO.Database 
    Dim dbLink As DAO.Database 
    Dim tdf As TableDef 

    Set dbCurr = CurrentDb 
    Dim strConn As String 
    Dim strNewDbConn1 As String 
    Dim strNewDbConn2 As String 
    Dim strNewDbConn As String 

    ' On Local Error GoTo fRefreshLinks_Err 

    'First get all linked tables in a collection' 
    dbCurr.TableDefs.Refresh 
    For Each tdf In dbCurr.TableDefs 
     With tdf 
      If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = TableDefAttributeEnum.dbAttachedTable) _ 
       And (.Name Like OnlyForTablesMatching) Then 

       strConn = tdf.Connect 
       strDBPath = Right(strConn, Len(strConn) - (InStr(1, strConn, "DATABASE=") + 8)) 
       strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\")) 
       Debug.Print ("===========================") 
       Debug.Print (" connect is " + strConn) 
       Debug.Print (" DB PAth is " + strDBPath) 
       Debug.Print (" DB Name is " + strDBName) 

       strDBNewPath = strNewPath & "\" & strDBName 
       Debug.Print (" DB NewPath is " + strDBNewPath) 

       strNewDbConn1 = Left(strConn, (InStr(1, strConn, "DATABASE=") - 1)) 
       strNewDbConn2 = "DATABASE=" & strDBNewPath 
       strNewDbConn = strNewDbConn1 & strNewDbConn2 
       Debug.Print (" DB strNewDbConn is " + strNewDbConn) 

       'Change the connect path 
       tdf.Connect = strNewDbConn 
       tdf.RefreshLink 
      End If 
     End With 
    Next 
End Function