---Soumis par Dev Ashish---
Concatener les valeurs d'un champ dans une table.
(Q) Il me faut concaténer les valeurs uniques d'un champ particulier dans un format "Valeur1; Valeur2; Valeur3" etc. pour tous les enregistrements d' une table. Comment faire?
(A) Utiliser la fonction fConcatFld function,
sur la base de données Northwind, à partir de la requête suivante, nous
retournera une liste de tous les CustomerIDs que nous regroupons par
ContactTitle.
SELECT ContactTitle,
fConcatFld("Customers","ContactTitle","CustomerID","string",[ContactTitle])
AS CustomersFROM CustomersGROUP BY ContactTitle;
'************ Code Start **********
Function fConcatFld(stTable As String, _
stForFld As String, _
stFldToConcat As String, _
stForFldType As String, _
vForFldVal As Variant) _
As String
'Retourne la valeur (unique) d'un champ par rapport
'à un autre champ dans la table,
'valeurs séparées par un point-virgule.
'
'Usage:
' ?fConcatFld(("Customers","ContactTitle","CustomerID", _
' "string","Owner")
'Où Customers = La table à utiliser
' ContactTitle = Le champ contre lequel on se compare
' CustomerID = Le champ fournissant les valeurs à concaténer
' string = Le DataType du champ contre lequel on se compare
' Owner = La valeur à laquelle on compare le champ à comparer (ContactTitle)
'
Dim lodb As Database, lors As Recordset
Dim lovConcat As Variant, loCriteria As String
Dim loSQL As String
Const cQ = """"
On Error GoTo Err_fConcatFld
lovConcat = Null
Set lodb = CurrentDb
loSQL = "SELECT [" & stFldToConcat & "] FROM ["
loSQL = loSQL & stTable & "] WHERE "
Select Case stForFldType
Case "String":
loSQL = loSQL & "[" & stForFld & "] =" & cQ & vForFldVal & cQ
Case "Long", "Integer", "Double": 'AutoNumber is Type Long
loSQL = loSQL & "[" & stForFld & "] = " & vForFldVal
Case Else
GoTo Err_fConcatFld
End Select
Set lors = lodb.OpenRecordset(loSQL, dbOpenSnapshot)
'Existe-t-il des enregistrements
With lors
If .RecordCount <> 0 Then
'commencer la concaténation
Do While Not .EOF
lovConcat = lovConcat & lors(stFldToConcat) & "; "
.MoveNext
Loop
Else
GoTo Exit_fConcatFld
End If
End With
'C'est tout... on possède la chaîne
'ne reste qu'à enlever le dernier ;
fConcatFld = Left(lovConcat, Len(lovConcat) - 2)
Exit_fConcatFld:
Set lors = Nothing: Set lodb = Nothing
Exit Function
Err_fConcatFld:
MsgBox "Error#: " & Err.Number & vbCrLf & Err.Description
Resume Exit_fConcatFld
End Function
'************ Code End **********