Public Sub Hs_Liste()
    Dim cat As New ADOX.Catalog
    Dim cmd As New ADODB.Command   
    cat.ActiveConnection = connstr
    cmd.CommandText = "SELECT * FROM hs ORDER BY prdno,selno,objno"
    cat.Views.Append "hsliste", cmd
    Set cat = Nothing
End Sub

Public Function Liste(ByVal myConn As Connection) As ADODB.Recordset
    Dim Rs  As New ADODB.Recordset
    Rs.Open "[hsliste]", myConn, adOpenStatic, adLockBatchOptimistic
    Set Liste = Rs
End Function

Public Function Liste(ByVal myConn As Connection) As Recordset
    Dim sSQL    As String
    Dim Rs      As ADODB.Recordset
    sSQL = "SELECT * FROM hs ORDER BY prdno,selno,objno"
    Set Rs = New ADODB.Recordset
    Rs.CursorLocation = adUseClient
    Rs.Open sSQL, myConn, adOpenStatic, adLockBatchOptimistic
    Set Liste = Rs
    Set Rs.ActiveConnection = Nothing
End Function

Public Sub CreateAnhang(ByVal sDB_PATH As String)
    Dim cat As New ADOX.Catalog
    Dim tbl As New ADOX.Table
    ' öffnen
    cat.ActiveConnection = connstr
    ' Tabelle definieren
    With tbl
        .Name = "hs"
        Set tbl.ParentCatalog = cat
        .Properties("Jet OLEDB:Create Link") = True
        .Properties("Jet OLEDB:Link Datasource") = sDB_PATH & "\DbVektor.mdb"
        .Properties("Jet OLEDB:Remote Table Name") = "hs"
    End With
    'Anhängen der Tabeele an die Auflistung
    cat.Tables.Append tbl
    Set cat = Nothing
End Sub