Сборка значений полей (конкатенация) понескольким записям (ADO - Позднее связывание)Public Function RecordsToStr(lValID As Long, Optional iFieldNo As Integer = 0) As Variant 'Конкатенация строк ... Dim sSQL As String, iLen As Integer, vVal Dim sRowDelimiter As String Dim rst As Object 'Используем "позднее связывание", если библиотека ADO подключена то As ADO.RecordSet '---------------------------------------------------------------------------------------------------[/REM] On Error GoTo RecordsToStr_Err Select Case iFieldNo Case 0 sRowDelimiter = ", " sSQL = "SELECT Название_Книги FROM тНазвание WHERE (ФИО_Читателя = " & lValID & ");" Case 1 sRowDelimiter = " + " sSQL = "SELECT Format([Стоимость_Книги], '# ##0.00') FROM тНазвание WHERE (ФИО_Читателя = " & lValID & ");" End Select Set rst = CreateObject("ADODB.Recordset") 'Получение списка 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, , , sRowDelimiter) 'Обрезка последнего "сепаратора" iLen = Len(vVal) - Len(sRowDelimiter) RecordsToStr = Mid(vVal, 1, iLen) End If RecordsToStr_End: On Error Resume Next rst.Close: Set rst = Nothing Err.Clear Exit Function RecordsToStr_Err: RecordsToStr = "Error: " & Err.Number 'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function : RecordsToStr - Module1.", vbCritical, "Error!" 'Debug.Print "RecordsToStr_Line: " & Erl & "." Err.Clear Resume RecordsToStr_End End Function
Справка по Метод GetString (ADO): По материалам: 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
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) Пример |
|||
L.E. 15.02.2023 |