Tabellenverknüpfung erstellen (ADO) Eine Funktion, mit der sich eine Datenbanktabelle aus einer externen Quelle dauerhaft in die aktiv geöffnete Datenbank einfügen lässt.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  14.606
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	kein Beispielprojekt

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 5 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Heute stellen wir Ihnen eine Funktion vor, mit der sich eine Datenbanktabelle aus einer externen Quelle (bspw. Access-Datenbank) dauerhaft in die aktiv geöffnete Datenbank einfügen lässt, so dass man anschließend auf die Daten der externen Tabelle so zugreifen kann, als wäre die Tabelle Bestandteil der eigenen Datenbank.

Public Function dbCreateLink(ByRef oConn As ADODB.Connection, _
  ByVal sExternFile As String, _
  ByVal sExternTable As String, _
  Optional ByVal sLinkTableName As String = "") As Boolean
 
  Dim oCat As ADOX.Catalog
  Dim oTable As ADOX.Table
 
  ' Fehlerbehandlung aktivieren
  On Error Goto ErrHandler
 
  ' Katalog-Objekt der aktiven Connection erstellen
  Set oCat = New ADOX.Catalog
  oCat.ActiveConnection = oConn
 
  ' neue Tabelle anlegen
  Set oTable = New ADOX.Table
  With oTable
    Set .ParentCatalog = oCat
 
    ' Name der Tabelle
    If Len(sLinkTableName) = 0 Then sLinkTableName = sExternTable
    .Name = sLinkTableName
 
    ' Eigenschaften der neuen Tabelle festlegen
    .Properties("Jet OLEDB:Create Link") = True
    .Properties("Jet OLEDB:Link Datasource") = sExternFile
    .Properties("Jet OLEDB:Remote Table Name") = sExternTable
  End With
  oCat.Tables.Append oTable
 
  dbCreateLink = True
 
  Set oCat = Nothing
  On Error Goto 0
  Exit Function
 
ErrHandler:
  MsgBox "Tabellenverknüpfung konnte nicht erstellt werden!" & vbCrLf & _
    "Fehler " & CStr(Err.Number) & vbCrLf & Err.Description
  dbCreateLink = False
  Set oCat = Nothing
End Function

Für das Hinzufügen einer neuen Tabelle zu einer bestehenden Connection benötigen wir einen Verweis auf die Microsoft ADO Ext 2.x for DDL and Security Library.

Aufrufbeispiel:
Es soll aus der Datenbank "d:\Test.mdb" die Tabelle "Kunden" in die aktuelle Datenbank als "Verweis" eingefügt werden.

' 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 dbCreateLink(oConn, "d:\Test.mdb", "Kunden", "KundenExt") Then
  ' ...
End If