---Soumis par Dev Ashish---

Retourne une liste concaténée de valeur d'enregistrements apparentés.

(Q)    Comment extraire toutes les valeurs d'une table liée à une autre table dans une relation 1:M ?

(A)    La fonction suivante,  fConcatChild, peut être utilisée dans une requête

SELECT Orders.*, fConcatChild("Order Details","OrderID","Quantity","Long",[OrderID]) AS SubFormValuesFROM Orders;

Cet exemple est basé sur les tables  Orders et Orders Details de la base de données  Northwind, tables dans une relation un-à-plusieurs. Ici, fConcatChild simplement concatène la valeur du champ Quantity des enregistrements ayant le champ OrderID, de datatype Long, égal à la valeur actuelle du champ [OrderID], pour la table Order Details.

'************ Code Start **********
Function fConcatChild(strChildTable As String, _
                    strIDName As String, _
                    strFldConcat As String, _
                    strIDType As String, _
                    varIDvalue As Variant) _
                    As String
'Retourne les valeurs d'un champ du coté M d'une relation 1:M 
'dans un format par séparateur de point- virgule
'
'Usage 
'   ?fConcatChild("Order Details", "OrderID", "Quantity", _
                "Long", 10255)
'où  Order Details = Table du coté multiple
'       OrderID       = Champ à comparer
'       Quantity      = Champ à concaténer
'       Long          = DataType du champ à comparer
'       10255         = Valeur pour la comparaison
'
Dim db As Database
Dim rs As Recordset
Dim varConcat As Variant
Dim strCriteria As String, strSQL As String
    On Error GoTo Err_fConcatChild
    
    varConcat = Null
    Set db = CurrentDb
    strSQL = "Select [" & strFldConcat & "] From [" & strChildTable & "]"
    strSQL = strSQL & " Where "
    
    Select Case strIDType
        Case "String":
            strSQL = strSQL & "[" & strIDName & "] = '" & varIDvalue & "'"
        Case "Long", "Integer", "Double":    'AutoNumber is Type Long
            strSQL = strSQL & "[" & strIDName & "] = " & varIDvalue
        Case Else
            GoTo Err_fConcatChild
    End Select
    
    Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)

    'Existe-t-il au moins un enregistrement?
    With rs
        If .RecordCount <> 0 Then
            'si oui, commencer la concaténation
            Do While Not rs.EOF
                varConcat = varConcat & rs(strFldConcat) & ";"
                .MoveNext
            Loop
        End If
    End With
        
    'Voilà... on possède la dite chaîne
    'enlever le dernier  ;
    fConcatChild = Left(varConcat, Len(varConcat) - 1)
        
Exit_fConcatChild:
    Set rs = Nothing: Set db = Nothing
    Exit Function
Err_fConcatChild:
    Resume Exit_fConcatChild
End Function

'************ Code End **********