Die Erhaltung verknüpften Tabellen für Access-DBs in demselben Ordner, wenn die Ordner Änderungen
-
22-08-2019 - |
Frage
Ich habe zwei Access-Datenbanken bekam die verknüpften Tabellen teilen. Sie werden zusammen in einem Verzeichnis bereitgestellt und über den Code in einem Word-Formular abgerufen.
Wie kann ich sicherstellen, dass die Verbindungen erhalten bleiben, wenn die beiden Datenbanken kopiert werden (zusammen) in einem anderen Ordner? Da ich nicht auf die Datenbank „Öffnen“, per se (es über ADO zugegriffen werden wird), weiß ich nicht, wie Sie Code schreiben, um die Verknüpfungen zu aktualisieren.
Lösung
Update 14APR2009 Ich fand, dass die vorherige Antwort, die ich hier gab fehlerhaft war, so dass ich es mit neuem Code aktualisiert.
So gehen Sie vor:
- Kopieren Sie den Code unten auf ein VBA-Modul.
-
Von Code oder aus dem Sofortige Fenster in der VBA-IDE, geben Sie einfach:
RefreshLinksToPath Application.CurrentProject.Path
Dies wird nun alle verknüpften Tabellen neu verknüpfen, das Verzeichnis zu verwenden, in denen Ihre Anwendung befindet.
Es muss nur einmal durchgeführt werden oder wenn Sie neue Tabellen neu verknüpfen oder ergänzen.
Ich empfehle, diese jedes Mal von Code tun Sie Ihre Anwendung starten.
Anschließend können Sie Ihre Datenbanken um ohne Probleme bewegen.
Code
'------------------------------------------------------------'
' 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
Dieser Code aus dieser Quelle angepasst ist: http://www.mvps.org/ Zugang / Tabellen / tbl0009.htm .
Ich entfernte alle Abhängigkeit von anderen Funktionen, die es in sich geschlossene zu machen, das ist, warum es ein bisschen länger ist als es sollte.
Andere Tipps
Beziehen Sie sich auf die Links in Ihrem Word-Formular zu aktualisieren oder die verknüpften Tabellenverknüpfungen zwischen den Access-Datenbanken?
Für die ersteren, der beste Weg, die ich kenne, ist die Verbindungszeichenfolge zu halten (s) auf Modulebene in Ihrem Word-Dokument / VBA-Projekt und sie const Strings machen. Dann, wenn die Verbindungszeichenfolge für Ihre ADO-Connection-Objekte festlegen, übergeben sie die relative Verbindungszeichenfolge konst.
Für letztere würde ich einen relativen Pfad in der Verbindungszeichenfolge, um Daten innerhalb der einzelnen Access-Datenbank zur anderen zu verwenden versucht sein. Zum Beispiel:
Dim connectionString as String
connectionString = ";DATABASE=" & CurrentProject.Path & "\[Database Name Here].mdb"
Wenn, wie Sie sagen, werden die Datenbanken zusammen in einen anderen Ordner kopiert (Ich bin angenommen in den gleichen Ordner).
Renaud Antwort funktioniert nicht mehr in Access 2010 mit Excel oder CSV-Dateien.
Ich habe ein paar Änderungen vorgenommen:
- Angepasst an die aktuellen Muster für die Verbindungszeichenfolge
- der Datenbankpfad anders für Excel-Dateien behandelt (inklusive Dateinamen) und CSV-Dateien (nicht enthält Dateinamen)
Hier ist der Code:
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
Ich bin leider immer noch auf Access 2007. Ich begann mit einem der Codeblöcke, über das nicht für mich arbeiten. Mit weniger Zugang vba Macht ich es nur die erste Schleife vereinfachte, die die Tabellen Pfade erhalten und aktualisiert es an seinem Platz. Der nächste Mann in diesen laufen kann kommentieren oder zu aktualisieren.
Option Compare 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