Access - 'Seek in verknüpften Tabellen'

Zitat aus der Access 2000-Hilfe:

Sie können die Seek -Methode nicht für eine verknüpfte Tabelle verwenden, weil verknüpfte Tabellen nicht als Recordset -Objekte vom Typ Tabelle geöffnet werden können. Wenn Sie dagegen die OpenDatabase-Methode verwenden, um eine Datenbank mit installierbarem ISAM (nicht-ODBC) direkt zu öffnen, können Sie Seek für die Tabellen in dieser Datenbank verwenden.

Und wie geht das? Zunächst muss man den Pfad und Namen der Datenbank, die die verknüpfte Tabelle enthält, ermitteln. Dazu dient die folgende Funktion. Wem das Kopieren der Code-Teile zu mühselig ist, der kann durch Klick auf den folgenden Link auch eine Demo-Datenbank runterladen: (75 kByte) .

Function FindeDatenMDB(TBlName As String)
 
'Bei Problemen mit Methoden und Verweisen
'bitte bei Access 2000 im VBA-Editor unter Extras/Verweise
'"Microsoft DAO 3.6 Object Library" aktivieren.
'S. dazu auch FAQ 7.11 auf http://www.donkarl.com
 
'Übergibt den Pfad zur Datenbank, in der die Tabelle "TblName" liegt.
 
Dim db As DAO.Database
Dim Tbl As DAO.TableDef
Dim Tmp As String
 
Set db = CurrentDb
Set Tbl = db.TableDefs(TblName)
 
Tmp = Tbl.Connect
FindeDatenMDB = ""
If Mid(Tmp, 1, 10) = ";DATABASE=" Then FindeDatenMDB = Mid(Tmp, 11)
 
End Function

Jetzt kann man eine Funktion schreiben, die mit den oben ermittelten Daten in der Tabelle sucht. Im folgenden Beispiel sind die entscheidenden Zeilen am Ende markiert. Bei der aufgeführten Funktion wird der Meßwert einer Dichtebestimmung gesucht. Die Dichte entspricht einem anderen Wert (g Extrakt/100 g Würze). Wenn der genaue Dichtewert nicht durch "Seek" (mit "=") gefunden wird, kann der Extraktwert durch zweimalige Anwendung von "Seek" (mit "<" und mit ">") interpoliert werden. Anschliessend wird gerundet (die Funktion dazu wird auch aufgeführt).

Public Function fctInterpol(strTabelle As String, strIndex As String, _
varWert As Variant, strFeldGegeben As String, _
strFeldLesen As String) As Double
 
On Error GoTo fctInterpol_Err
 
'Testaufruf im Direktfenster mit:
'?fctInterpol("Dichte","Bschwinger",1.02,"Bschwinger","g_in_100g")
 
Dim db As DAO.Database   '*
Dim rs As DAO.Recordset  '*
 
'speichert den zu übergebenden Wert
'(ist eigentlich überflüssig):
Dim dblUebergabe As Double
'für Zwischenwerte bei der Interpolation:
Dim dblBU As Double, dblBO As Double
Dim dblSU As Double, dblSO As Double
Dim dblF As Double, dblErg As Double
 
 
Set db = DBEngine.Workspaces(0).OpenDatabase(FindeDatenMDB(strTabelle))  '*
Set rs = db.OpenRecordset(strTabelle, dbOpenTable)  '*
 
With rs
  .Index = strIndex   '*
  .Seek "=", varWert  '*
 
  If Not .NoMatch Then
    dblUebergabe = rs(strFeldLesen)
   Else
    'Wert nicht gefunden, daher Interpolation starten
    .Seek "<", varWert           '*
    dblBU = rs(strFeldLesen)     '*
    dblSU = rs(strFeldGegeben)   '*
    .Seek ">", varWert           '*
    dblBO = rs(strFeldLesen)
    dblSO = rs(strFeldGegeben)
    dblF = (varWert - dblSU) / (dblSO - dblSU)
    dblErg = dblBU + (dblF * (dblBO - dblBU))
    dblUebergabe = fctRound(dblErg, 4)
  End If
End With
 
fctInterpol = dblUebergabe
 
fctInterpol_Exit:
   'Aufräumen nicht vergessen:
   If Not rs Is Nothing Then rs.Close: Set rs = Nothing
   If Not db Is Nothing Then db.Close: Set db = Nothing
   Exit Function
 
fctInterpol_Err:
   Select Case Err.Number
     Case 3021
       MsgBox "Fehler in 'fctInterpol'" & vbCrLf & vbCrLf & Err.Description _
       & vbCrLf & vbCrLf & "Dieser Fehler deutet darauf hin, dass der " _
       & "Wertebereich der Tabelle nicht eingehalten wurde!" _
       , vbCritical, "Fehler #" & Err.Number
     Case Else
       MsgBox "Fehler in 'fctInterpol'" & vbCrLf & vbCrLf & Err.Description, _
       vbCritical, "Fehler #" & Err.Number
   End Select
   Resume fctInterpol_Exit
 
End Function
 
 
 
Function fctRound(Optional VarNr, Optional varPl As Integer = 2) As Double
 
'by Konrad Marfurt + (null string by) Luke Chung + Karl Donaubauer
'raus hier bei vergessenem oder nicht-nummerischem Argument
If IsMissing(varNr) Or Not IsNumeric(varNr) Then Exit Function
 
fctRound = Fix("" & varNr * (10 ^ varPl) + Sgn(varNr) * 0.5) / (10 ^ varPl)
 
End Function

Menü :

Access

Access - 'Seek in verknüpften Tabellen'