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.744 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 März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevDTA 3.0 Pro SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. |
||||||||||||||||
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. |