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.976 
www.abiss.deSystem:  Win9x, WinXP, Vista, Win7, Win8, Win10kein Beispielprojekt 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise bis zu 120,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 479,20 EUR statt 599,- EUR
  • sevDTA 3.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 20,00 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 55,20 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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.976 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