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

Сборка значений полей (конкатенация) понескольким записям (ADO - Позднее связывание)

https://www.cyberforum.ru/ms-access/thread3079054-page2.html#post16753163

Public Function RecordsToStr(PacID As Long) As Variant '!!! - используется в запросе: "qf_СотрудникЛента"
'Конкатенация строк ...
'---------------------------------------------------------------------------------------------------
Dim sSQL$, vVal, iLen%
Const sRowsSeparator$ = ","
Dim rst As Object 'Используем "позднее связывание", если библиотека ADO подключена то As ADO.RecordSet

    sSQL = "SELECT категория FROM DriveLicense WHERE id_persona = " & PacID
    Set rst = CreateObject("ADODB.Recordset")
'Получение списка
    'RecordsToStr = CurrentProject.Connection.Execute(sSQL). _
        GetString(ColumnDelimeter:="; ", RowDelimeter:=vbCrLf) & ""
    rst.Open sSQL, CurrentProject.Connection, 3, 1, 1
    If Not rst.EOF Then
        'Применение метода GetString (ADO):
        '... rs.GetString(StringFormat, NumRows, ColumnDelimiter, RowDelimiter, NullExpr)
        '    1й аргумент: StringFormat всегда (и по умолчанию видимо) = 2 (adClipString)
        '    2й аргумент: NumRows - Количество строк, которые необходимо преобразовать. Тут = Все!
        '    3й аргумент: Разделитель, используемый между столбцами, по умолчанию = символ TAB.
        '                 Тут пробел = " "
        '    4й аргумент: RowDelimiter - Разделитель строк, по умолчанию = Перевод строки (Chr(13))
        '    5й аргумент: NullExpr - Замещает пустые значения полей, по умолчанию = пустая строка
        '                 Тут "н/д!" (нет данных!)
        'Получение списка:
        vVal = rst.GetString(2, , , sRowsSeparator)
        
        iLen = Len(vVal) - Len(sRowsSeparator)
        RecordsToStr = Mid(vVal, 1, iLen) 'Обрезка последнего "сепаратора"
    End If

    On Error Resume Next
    rst.Close: Set rst = Nothing
    Err.Clear

End Function



Справка по Метод GetString (ADO):
https://learn.microsoft.com/ru-ru/sql/ado/reference/ado-api/getstring-method-ado?view=sql-server-ver16

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

Public Function RelativesVal(vRecID, Optional sRowsSeparator$ = vbCrLf, Optional vNoValueReturn) As Variant
'Возвращает строку "список родственников" для одной записи из таблицы "Личный состав"
'Если ничего не найдено, то = Null
'----------------------------------------------------------------------------------------
'Аргументы:
'   vRecID         : Код записи для нахождения родни по полю: "Родственники.рдсЛичныйСоставSID"
'   vRowsSeparator : Разделитель строк, по умолчанию = Перевод строки
'   vNoValueReturn : Значение возвращаемое если ничего не найдено, по умолчанию = Null
'----------------------------------------------------------------------------------------
'Примеры использования:
'  ?RelativesVal(1)        ' С переводом строки (по умолчанию)
'  ?RelativesVal(2, "; ")  ' Через точку с запятой + пробел
'----------------------------------------------------------------------------------------
Dim rst As Object 'Используем "позднее связывание", если библиотека ADO подключена то As ADO.RecordSet
Dim vVal, sVal$, iLen%
'----------------------------------------------------------------------------------------
On Error GoTo RelativesStr_Err
    Set rst = CreateObject("ADODB.Recordset")

'Строим запрос "список родственников" по переданному vRecID
    sVal = "SELECT [сртСтепеньРодства] & ':' AS СтепеньР, рдсФамилия, рдсИмя, рдсОтчество, " & vbCrLf & _
                "IIf(Not IsNull([рдсДатаРождения]),Year([рдсДатаРождения]) & 'гр') AS ГодРождения " & vbCrLf & _
            "FROM СтепениРодства INNER JOIN Родственники " & vbCrLf & _
            "   ON СтепениРодства.СтепеньРодстваID = Родственники.рдсСтепеньРодстваSID " & vbCrLf & _
            "WHERE (рдсЛичныйСоставSID = " & vRecID & ") ORDER BY рдсДатаРождения;"
    
    '... rst.Open - Значения: 3 = adOpenStatic, 1 = adLockReadOnly, 1 = adCmdText
    rst.Open sVal, CurrentProject.Connection, 3, 1, 1
    If Not rst.EOF Then
        'Применение метода GetString (ADO):
        '... rs.GetString(StringFormat, NumRows, ColumnDelimiter, RowDelimiter, NullExpr)
        '    1й аргумент: StringFormat всегда (и по умолчанию видимо) = 2 (adClipString)
        '    2й аргумент: NumRows - Количество строк, которые необходимо преобразовать. Тут = Все!
        '    3й аргумент: Разделитель, используемый между столбцами, по умолчанию = символ TAB.
        '                 Тут пробел = " "
        '    4й аргумент: RowDelimiter - Разделитель строк, по умолчанию = Перевод строки (Chr(13))
        '    5й аргумент: NullExpr - Замещает пустые значения полей, по умолчанию = пустая строка
        '                 Тут "н/д!" (нет данных!)
        vVal = rst.GetString(2, , " ", sRowsSeparator, "н/д!")
        iLen = Len(vVal) - Len(sRowsSeparator)
        RelativesVal = Mid(vVal, 1, iLen) 'Обрезка последнего "сепаратора"
    Else
        RelativesVal = vNoValueReturn
    End If
    
RelativesStr_End:
    On Error Resume Next
    rst.Close: Set rst = Nothing
    Err.Clear
    Exit Function

RelativesStr_Err:
    Debug.Print "Err# " & Err & " - " & Err.Description
    Err.Clear
    Resume RelativesStr_End
End Function


Picture




Ещё один "короткий" вариант (строчки через запятую):

Private Function ConcatStr(sSQL) As Variant
Dim rs As Object, sVal As String
    Set rs = CreateObject("ADODB.Recordset")
    With rs
        .Open sSQL, CurrentProject.Connection, 3, 1
        If Not .EOF Then
            sVal = .GetString(, , , ", ")
            sVal = Left(sVal, Len(sVal) - 2)
            ConcatStr = sVal
        Else
            ConcatStr = Null
        End If
    .Close
    End With
    Set rs = Nothing
End Function




Скачать

MSA-2007 ( 80 kB) Пример


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