vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Datenbanken · DAO   |   VB-Versionen: VB6, VBA17.05.13
Datensätze verbinden und in einem Gesamtstring zusammensetzen

Mit der JoinRecords-Funktion wird der Feldinhalt aus mehreren Datensätzen zu einem Gesamtstring zusammengesetzt.

Autor:   Jean Pierre AllainBewertung:  Views:  5.943 
www.abiss.deSystem:  Win9x, WinXP, Vista, Win7, Win8, Win10kein Beispielprojekt 

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.
Mit der JoinRecords-Funktion wird der Feldinhalt aus mehreren Datensätzen zu einem Gesamtstring zusammengesetzt.

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;



Anzeige

Kauftipp Unser Dauerbrenner!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.
 
 
Copyright ©2000-2019 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


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.