Verlinkte Access Datenbanken umziehen lassen

Ich muss gelegentlich eine Access-Datenbank umziehen lassen, die auf diverse verlinkte Datenbanken zugreift (um das 2 GB Maximum zu umgehen). Da die Verlinkungen absolut sind und nicht relativ, muss man jede Verlinkung nach dem Umzug manuell anpassen, was bei mehr als 100 Tabellen mühselig und fehlerträchtig ist. Basierend auf Code von Stackexchange/Stackoverflow habe ich daher ein paar Hilfsfunktionen gebaut, die den Umzug deutlich vereinfachen. Die Annahme

Der Code besteht aus mehreren Funktionen:

  • getDatabaseName() extrahiert den Namen der Datenbank aus dem Pfad
  • GetFolder()
  • fragt beim Nutzer den Pfad ab, in dem die neuen Datenbank-Dateien liegen.

  • verlinkeTabellenNeu() biegt die Links auf die Datenbankdateien um

Hinweis: Es empfiehlt sich nach Abschluss ein Auslesen aller Verlinkungen und Abgleichen z.B. in Excel, um auf Nummer sicher gehen zu können, dass alle Verlinkungen erfolgreich waren. Zum Auslesen der Verlinkungen kann man den Code unten am Ende des Artikels nutzen.

Option Compare Database
 
Function getDatabaseName(currentPath As String)
    ' Uwe Ziegenhagen, 2017-11-03
    ' Extrahiert den Namen der Datenbank aus dem Pfad,
    ' wertet dazu die Position des letzten "\" aus:
    ' von innen nach außen:
    ' kehre String um
    ' finde den letzten Backslash
    ' nimm den substring bis zum letzten Backslash
    ' reverse diesen Substring wieder
 
getDatabaseName = StrReverse(Left(StrReverse(currentPath), InStr(StrReverse(currentPath), "\") - 1))
 
End Function
 
Function GetFolder() As String
' https://stackoverflow.com/questions/26392482/vba-excel-to-prompt-user-response-to-select-folder-and-return-the-path-as-string
' based on https://www.ozgrid.com/forum/forum/help-forums/excel-general/126180-getfolder-function?t=182343
 
' requires references to Microsoft Office xx.0 Object library
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        '.InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function
 
Sub verlinkeTabellenNeu()
' Uwe Ziegenhagen, 2017-11-03
' Ruft vom User einen Pfad ab und verlinkt alle Tabellen mit diesem Pfad neu
' based on code from https://stackoverflow.com/questions/4928134/changing-linked-table-location-programatically
 
ordnerNeu = GetFolder()
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Set dbs = CurrentDb()
 
    With dbs
        For Each tdf In .TableDefs
        'Is the table a linked table?
            If tdf.Attributes And dbAttachedODBC Or tdf.Attributes And dbAttachedTable Then
                With tdf
                    oldPath = .Properties("Connect").Value
                    .Connect = ";DATABASE=" & ordnerNeu & "\" & getDatabaseName(.Properties("Connect").Value)
                    .RefreshLink
                    Debug.Print oldPath & "@@@" & .Properties("Connect").Value
                End With
            End If
        Next tdf
    End With
 
End Sub

Code zum Auslesen der Verlinkungen

Sub LinkedTableConnection()
' http://p2p.wrox.com/access-vba/37117-finding-linked-tables.html
   Dim dbs As DAO.Database
   Dim tdf As DAO.TableDef
 
   Set dbs = CurrentDb()
 
    With dbs
        For Each tdf In .TableDefs
        'Is the table a linked table?
            If tdf.Attributes And dbAttachedODBC Or tdf.Attributes And dbAttachedTable Then
                With tdf
                    ' Connect property contains path of link
                    ' Debug.Print "Connect Property of " & .Name & " is: " &  .Properties("Connect").Value
                    Debug.Print "kompletter Pfad: " & tdf.Connect
                    ' Debug.Print "Name der Datenbank: " & getDatabaseName(.Properties("Connect").Value)
                End With
            End If
        Next tdf
    End With
End Sub

Uwe

Uwe Ziegenhagen mag LaTeX und Python, auch gern in Kombination. Hat Dir dieser Beitrag geholfen und möchtest Du Dich dafür bedanken? Dann unterstütze doch vielleicht die Dingfabrik Köln e.V. mit einem kleinen Beitrag. Details zur Bezahlung findest Du unter Spenden für die Dingfabrik.

More Posts - Website