vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
vb@rchiv Offline-Reader - exklusiv auf der vb@rchiv CD Vol.4  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
zurück
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:     [ Jetzt bewerten ]Views:  3.850 
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;

Dieser Tipp wurde bereits 3.850 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


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.
 
   

Druckansicht Druckansicht Copyright ©2000-2017 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel