Public Function LinkedTable(strSourceDBPfad As String, strSourceTableName As _
  String, _
                               Optional strTargetTableName As String) As Boolean
'*******************************************
'Name:      LinkedTable   (Function)
'Purpose:   Einbinden von Tabellen aus mdb-DB's
'Author:    Thomas Keßler
'Date:      April 07, 2003, 04:34:33
'Inputs:    strSourceDBPfad=Daten + komplettem Pfad der QuellDB
'           strSourceTableName= Quelltabellenname, strTargetTableName= 
' Zieltabellenname
'Output:    True= Verknüpfung erstellt sonst False
'*******************************************
On Error GoTo ErrHandler
 
    Dim dbSource As DAO.DATABASE, dbTarget As DAO.DATABASE
    Dim tdf As DAO.TableDef
    Dim strPWDSource As String, strPWDTarget As String
 
    ' Wenn kein Zielname angegeben dann = Quellname
    If IsNull(strTargetTableName) Or strTargetTableName = "" Then _
      strTargetTableName = strSourceTableName
 
    Set dbTarget = CurrentDb()
    Set dbSource = OpenDatabase(strSourceDBPfad)
    Set tdf = dbTarget.CreateTableDef(strTargetTableName)
        tdf.Connect = ";DATABASE=" & strSourceDBPfad & strPWDSource
        tdf.SourceTableName = strSourceTableName
        dbTarget.TableDefs.Append tdf
    LinkedTable = True
 
    dbSource.Close
    dbTarget.Close
 
GoTo ExitHere
 
ExitHere:
    Exit Function
ErrHandler:
    LinkedTable = False
    If Err = 3012 Then
        MsgBox "Tabelle ist bereits in der Ziel-DB vorhanden.@Ändern Sie die" & _
          "Bezeichnung der Tabelle oder wählen Sie eine andere Tabelle aus." & _
               "@Der Vorgang wird beendet", vbCritical + vbOKOnly, "Fehler...!"
        GoTo ExitHere
    Else
        Dim strErrString As String
        strErrString = "Error Information..." & vbcrlf
        strErrString = strErrString & "Error#: " & Err.Number & vbcrlf
        strErrString = strErrString & " Description: " & Err.Description & _
          vbcrlf
        MsgBox strErrString, vbCritical + vbOKOnly, "Error in Modul mod_DAO in" & _
        "Function: LinkedTableAll"
        Resume ExitHere
    End If
End Function

If LinkedTable("C:\Test\Test.mdb", "tblTest", "tblTestNew") = True Then
    MsgBox "Tabelle erfolgreich eingebunden"
Else
    MsgBox "Tabelle nicht eingebunden"
End If

Gru? TommyK