VBA, MS Access MS Access в примерах

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

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

Public Function RecordsToStr(PacID As Long) As String
'Например: = RecordsToStr([идОбъект])
Dim sSQL$
    sSQL = "SELECT Препарат FROM [Схемы лечения] WHERE [Номер пациента] =" & PacID
    RecordsToStr = QueryDataToLine(sSQL)
End Function

Private Function QueryDataToLine(sSQLStr, Optional sFieldName$ = "", Optional sCut$ = ", ") As String
'es 29.08.2018 LE 14.07.2022
'Возвращает строку по данным запроса (сборка значений поля по всем записям - одной строкой)
'--------------------------------------------------------------------------
'Аргументы:
'   sSQLStr        - SQL строчка источник аданных (Название запроса - Таблицы)
'   sFieldName     - Название поля в источнике данных - Откуда?!
'   sCut           - Опционально: Разделитель значений (по умолчанию = ", ")
'--------------------------------------------------------------------------
' = QueryDataToLine( "Запрос_СписокМатериалов"; "Материал", "; " )
'--------------------------------------------------------------------------

Dim rst As DAO.Recordset
Dim i As Integer
Dim fld As Field, v As Variant
On Error GoTo QueryDataToLine_Err
    
    Set rst = CurrentDb.OpenRecordset(sSQLStr, dbOpenSnapshot)
    
    With rst
        Do Until .EOF = True 'Цикл до конца
            If sFieldName = "" Then 'Поле не задано
                For Each fld In rst.Fields
                    v = v + sCut & fld.Value 'Конкатенация строки v1
                Next fld
            Else 'Поле задано чётко
                v = v & sCut & .Fields(sFieldName)  'Конкатенация строки v2
            End If
            .MoveNext
            
        Loop
    End With
    If Len(v) > 2 Then QueryDataToLine = Mid(v, 3)
    

QueryDataToLine_End:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Exit Function
    
QueryDataToLine_Err:
    QueryDataToLine = "ERR: " & Err.Number
    Resume QueryDataToLine_End
End Function



Запрос:

SELECT [Номер пациента] AS КодПациента, RecordsToStr([Номер пациента]) AS Препараты
FROM [Схемы лечения] GROUP BY [Номер пациента] ORDER BY [Номер пациента];



Picture




Скачать

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


Назад ToTop
L.E. 14.02.2023
Рейтинг@Mail.ru