Сборка значений полей (конкатенация) по записям из источника данных (DAO) v06

По материалам: https://www.cyberforum.ru/ms-access/thread3007700.html

Public Function DataСoncatenation(sSQLStr, Optional sFieldName$, _
        Optional sRowsDelimiter$ = ", ", Optional sFieldsDelimiter$ = " ") As String
' (modСoncatenation) es 29.08.2018 LE 20.01.2024 v06
' Конкатенация строк из SQL запроса (сохранённого запроса или таблицы)
' Возвращает строку значений поля(ей) всех возвращаемых записей с заданным разделителем(ми)
'--------------------------------------------------------------------------
'Аргументы:
'   sSQLStr          - SQL строчка источник данных (или имя запроса - таблицы)
'   sFieldName       - Опционально: Название поля в источнике данных - Откуда?! (по умолчанию все поля)
'   sRowsDelimiter   - Опционально: Разделитель значений записей   (по умолчанию запятая с пробелом = ", ")
'   sFieldsDelimiter - Опционально: Разделитель значений полей     (по умолчанию пробел = " ")
'--------------------------------------------------------------------------
' = DataNoncatenation("Запрос_СписокМатериалов"; "Материал", "; " )
'--------------------------------------------------------------------------

Dim rst As DAO.Recordset
Dim fld As Field, sVal As String, sTemp As String, iLen As Integer
On Error GoTo DataСoncatenation_Err
    
    Set rst = CurrentDb.OpenRecordset(sSQLStr, dbOpenSnapshot)
    
'Конкатенация полей и строк
    With rst
        Do Until .EOF = True        'Цикл до конца набора записей
            If sFieldName = "" Then 'Если Поле не задано - проход по всем возвращаемым полям
                If rst.Fields.Count > 1 Then 'Передано несколько полей (больше одного)
                    iLen = Len(sFieldsDelimiter)
                    sTemp = ""
                    For Each fld In rst.Fields
                        sTemp = sTemp + sFieldsDelimiter & fld.Value
                    Next fld
                    If Len(sTemp) > iLen Then sTemp = Mid(sTemp, iLen + 1)
                    sVal = sVal & sRowsDelimiter & sTemp
                Else 'Передано только одно поле
                    sVal = sVal & sRowsDelimiter & .Fields(0)
                End If
                
            Else 'Поле задано чётко
                sVal = sVal & sRowsDelimiter & .Fields(sFieldName)
            End If
            .MoveNext
        Loop
    End With
    
    iLen = Len(sRowsDelimiter)
    If Len(sVal) > iLen Then DataСoncatenation = Mid(sVal, iLen + 1)

DataСoncatenation_End:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Exit Function
    
DataСoncatenation_Err:
    DataСoncatenation = "ERR: " & Err.Number
    'Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in Function: DataСoncatenation"
    Resume DataСoncatenation_End
End Function

Код из примера:

Private Sub TestDemo() 'демонстрация вариантов в Immediate окне ...
Dim sSQL As String, lPatientID As Long 'Код пациента
    
    lPatientID = 5

'Вариант из 3-х полей через пробел и записи через точку с запятой
    sSQL = "SELECT Препарат, КолВо, Размерность FROM [Схемы лечения] " & _
            "WHERE [Номер Пациента]=" & lPatientID
    Debug.Print DataСoncatenation(sSQL, , "; ", " ")
    'вернёт: Ламивудин 300 мг; Тенофовир 300 мг; Эфавиренз 600 мг
    
'Вариант c одним полем (выражением) - записи через запятую (всё ещё проще и на автомате)
    sSQL = "SELECT [Препарат] & "" - "" & [КолВо] & [Размерность] AS ВыражениеЗапроса " & _
            "FROM [Схемы лечения] WHERE [Номер Пациента]=" & lPatientID
    Debug.Print DataСoncatenation(sSQL)
    'вернёт: Ламивудин - 300мг, Тенофовир - 300мг, Эфавиренз - 600мг

'Вариант с указанием поля - записи через через точку с запятой
    sSQL = "SELECT * FROM [Схемы лечения] WHERE [Номер Пациента]=" & lPatientID
    Debug.Print DataСoncatenation(sSQL, "Препарат", "; ")
    'вернёт: Ламивудин; Тенофовир; Эфавиренз
    
End Sub

Public Function RecordsToStr(lPatientID As Long) As String
' функция "оболочка" - используется в запросе "Query01" и в форме "Form01"
'--------------------------------------------------------------------------
'Примеры использования:
'   Препараты: RecordsToStr([Номер Пациента]) ...  - в запросе "Query1"
'   =RecordsToStr([Номер Пациента]) ...            - в форме "Form01"
'   ?RecordsToStr(5) ... - ТУТ в Immediate окне VBE (Ctrl + G)
'--------------------------------------------------------------------------
Dim sSQL$

'Вариант c одним полем (выражением) - записи через запятую (всё на автомате)
    sSQL = "SELECT [Препарат] & "" - "" & [КолВо] & [Размерность] AS ВыражениеЗапроса " & _
            "FROM [Схемы лечения] WHERE [Номер Пациента]=" & lPatientID
    RecordsToStr = DataСoncatenation(sSQL)
   
End Function

MSA-2007 и выше ( 200 kB) Пример