Vor kurzem haben wir Ihnen gezeigt, wie man per Quellcode Verknüpfungen zu externeb Datenbank-Tabellen in eine bestehende Datenbank einfügen kann. Jetzt kommt es natürlich auch vor, dass sich der Speicherort (sprich Laufwerk und Verzeichnis) der externen Datenbanken ändert, so dass die Verknüpfungen auf eingebundene Tabellen nicht mehr funktioniert. Mit nachfolgendem Code lassen sich die Pfadangaben aktualisieren. ' Tabellenverknüpfungen prüfen und ggf. aktualisieren Public Function dbRefreshLink(ByRef oConn As ADODB.Connection, _ ByVal sNewPath As String, _ Optional ByVal sExternTable As String = "") As Boolean Dim oRs As ADODB.Recordset Dim oCat As ADOX.Catalog Dim sTable As String Dim sPath As String Dim sFile As String ' Fehlerbehandlung aktivieren On Error GoTo ErrHandler ' ggf. abschließenden Backslash anfügen If Right$(sNewPath, 1) <> "\" Then sNewPath = sNewPath & "\" ' Katalog-Objekt der aktiven Connection erstellen Set oCat = New ADOX.Catalog oCat.ActiveConnection = oConn ' Datenbank-Schema lesen Set oRs = oConn.OpenSchema(adSchemaTables) Do Until oRs.EOF ' Handelt es sich um eine Tabellenverknüpfung? If oRs("TABLE_TYPE") = "LINK" Then ' Name der Tabelle ermitteln sTable = "" & oRs("TABLE_NAME") ' Handelt es sich um die zu aktualisierende Tabellenverknüpfung? If sTable = sExternTable Or Len(sExternTable) = 0 Then With oCat.Tables(sTable) ' Pfad zur externen Datenquelle ermitteln sPath = "" & .Properties("Jet OLEDB:Link Datasource") If InStr(sPath, "\") > 0 Then ' Pfad und Dateiname splitten sFile = Mid$(sPath, InStrRev(sPath, "\") + 1) sPath = Left$(sPath, InStrRev(sPath, "\")) ' Pfad aktualisieren, falls notwendig If LCase$(sPath) <> LCase$(sNewPath) Then .Properties("JET OLEDB:Link Datasource") = sNewPath & sFile End If End If End With End If End If oRs.MoveNext Loop ' Aufräumen - Objekte schließen und freigeben oRs.Close Set oRs = Nothing Set oCat = Nothing dbRefreshLink = True On Error GoTo 0 Exit Function ErrHandler: MsgBox "Tabellenverknüpfung konnte nicht aktualisiert werden!" & vbCrLf & _ "Fehler " & CStr(Err.Number) & vbCrLf & Err.Description dbRefreshLink = False Set oCat = Nothing End Function Für das Aktualisieren der Tabellenverknüpfungen benötigen wir einen Verweis auf die Microsoft ADO Ext 2.x for DDL and Security Library. Aufrufbeispiel: ' Eigene Datenbank öffnen Dim oConn As ADODB.Connection Set oConn = New ADODB.Connection With oConn .Provider = "Microsoft.Jet.OLEDB.4.0" .Properties("Data Source") = App.Path & "\MyMDB.mdb" .Properties("Persist Security Info") = False .Open End With ' jetzt die Tabellenverknüpfung erstellen und hinzufügen If dbRefreshLink(oConn, "d:\temp", "KundenExt") Then ' ... End If Tipp: Dieser Tipp wurde bereits 17.103 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |