Eine relationale Datenbanken bietet die Möglichkeit zu einem Hauptdatensatz "n" viele Unterdatensätze zu zuordnen. Z.B. werden hier mehrere Gruppen zu einem Kontakt zugeordnet: ID Suchname Zugeordnete Gruppen 1 JP Allain Feunde 1 JP Allain Geschäftlich 1 JP Allain Familie 2 Peter Maier Feunde 2 Peter Maier Geschäftlich Leider hat die Jet-SQL keine eigene Concat-Anweisung, um die Datensätze eines Hauptdatenstzes in einem Feld auszugeben, so wie in dieser Form: ID Suchname Zugeordnete Gruppen 1 JP Allain Familie; Feunde; Geschäftlich 2 Peter Maier Feunde; Geschäftlich Abhilfe schafft hier eine kleine flexible VBA-Funktion. Public Function JoinRecords(Fieldname As String, _ TableQueryName As String, _ Optional Criteria As String, _ Optional SeparatorChars As String = "; ", _ Optional MaxRows As Long = 0, _ Optional MaxChars As Long = 0, _ Optional NoNullFields As Boolean = True, _ Optional FinalChars As String = "...", _ Optional ErrSilent As Boolean = True, _ Optional ByRef ErrDescription As String, _ Optional ByRef ErrNumber As Long) As String ' Fieldname = Feldname aus der Tabelle/Abfrage der verwendet werden soll. ' TableQueryName = Tabelle- oder Abfragename die die 1:n Datensätze liefert. ' Criteria = Kriterien um den Datenbereich einzuschränken ' (Angabe wie bei der WHERE-Klausel). ' SeparatorChars = Gewünschte Trennzeichen zwischen den verketteten Texten. ' MaxRows = Maximale Anzahl Zeilen die aus TableQueryName gelesen werden sollen. ' Bei 0 keine Begrenzungen. ' MaxChars = Maximale Anzahl Zeichen die die Funktion zurückgeben soll. Bei ' Überschreitung, wird die Begrenzung eingehalten und der Text aus der Variable ' "FinalChars" wird am Ende verkettet. Bei 0 keine Begrenzungen. ' NoNullFields = Überspringt die Zeile, wenn der Wert im Feld Fieldname Null ist. ' FinalChars = Gewünschter Text der erscheint, wenn die MaxChars-Zahl überschritt ist. ' ErrSilent = Keine Fehlermeldung ausgeben ' ErrDescription = Enthält bei Fehler die Fehlerbeschreibung ' ErrNumber = Enthält bei Fehler die Fehlernummer Static db As Object ' DAO.Database Dim rs As Object ' DAO.Recordset Dim t As String Dim f() As String Dim i As Long On Error GoTo Treat_Err If db is Nothing Then Set db = Currentdb() ' Access; VB = DB-Objekt!!! t = " WHERE " If Len(Criteria) > 0 Then Criteria = t & "(" & Criteria & ")" t = " AND " End If If NoNullFields Then Criteria = Criteria & t & "[" & Fieldname & "] Is Not Null" Set rs = db.OpenRecordset("SELECT [" & Fieldname & "] FROM [" & TableQueryName & "]" & Criteria, 4) If Not rs.EOF Then rs.MoveLast rs.MoveFirst If MaxRows > 0 And rs.RecordCount > MaxRows Then MaxRows = MaxRows - 1 Else MaxRows = rs.RecordCount - 1 End If ReDim f(MaxRows) For i = 0 To MaxRows f(i) = rs(0) & "" rs.MoveNext Next t = Join(f, SeparatorChars) If MaxChars > 0 Then If Len(t) > MaxChars Then t = left(t, MaxChars - Len(FinalChars)) & FinalChars End If JoinRecords = t End If Exit_Proc: On Error Resume Next rs.Close Set rs = Nothing Exit Function Treat_Err: ErrDescription = Err.Description ErrNumber = Err.Number If ErrSilent Then JoinRecords = "Error " & Err.Number & " " & Err.Description Else Beep MsgBox Err.Description, vbCritical, "Error " & Err.Number End If Resume Exit_Proc End Function Anwendungsbeispiel: SELECT tblKontakt.ID, tblKontakt.Suchname, joinrecords("Bezeichnung","qryGruppen","KontaktID=" & [ID]) AS [Zugeordnete Gruppen] FROM tblKontakt SQL-Code vom Abfrage-Objekt "qryGruppen": SELECT G.Bezeichnung, Z.KontaktID FROM tblGruppe AS G INNER JOIN tblZuordnungKontaktGruppe AS Z ON G.ID = Z.GruppeID GROUP BY G.Bezeichnung, Z.KontaktID ORDER BY Z.KontaktID, G.Bezeichnung; Dieser Tipp wurde bereits 7.769 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 sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. |
||||||||||||||||
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. |