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

Функция GetData() - Возврат значения из поля таблицы (запроса) по условиям

Часто нужно "вытащить" значение поля конкретной записи определённой таблицы (запроса).
Для этого есть функция DLookup()
Это её аналог, но побыстрее и функциональнее.

Public Function GetData(sExpression As String, sSourсe As String, _
        Optional vCriteria As Variant = Null, _
        Optional vDefault As Variant = Null, _
        Optional vOptions As Variant = Null) As Variant
'--------------------------------------------------------------------
' Функция аналог DLookup(), но побыстрее и функциональнее.
' es 29.07.2016: LE 12.08.2019 : v002 : msa.polarcom.ru

' msa.polarcom.ru
'--------------------------------------------------------------------
'Аргументы:
'	sExpression - Название Поля или Выражение (ну как первый аргумент в DLookUp ...) 
'	sSource     - Название источника данных (Откуда?!) - имя Таблицы или Запроса
'	vCriteria   - Критерии отбора записей для WHERE ... (опционально - как третий аргумент в DLookUp ...) 
'	vDefault    - Значение возвращаемое если искомое не найдено (опционально - по умолчанию = Null)
'	vOptions    - Поле и Порядок сортировки опционально (Типа: " ORDER BY [Имя поля]" + " DESC" и т.п.)
'--------------------------------------------------------------------
'Возвращает:
'   Значение (выражения) указанное в sExpression из таблицы или запроса указанного в sSourсe
'   по условиям отбора указанным в vCriteria (Опционально)
'При ошибке или отсутствии данных в источнике:
' - Вернет значение  указанное в vDefault (по умолч. = Null)
'--------------------------------------------------------------------

Dim str As String
Dim rst As DAO.Recordset
'--------------------------------------------------------------------
On Error GoTo GetData_Err
    str = "SELECT " & sExpression & " FROM " & sSourсe & (" WHERE " + vCriteria) & (" " + vOptions)
    Set rst = CurrentDb.OpenRecordset(str, dbReadOnly) ', Тесты показали что dbReadOnly - Самый быстрый
    
    GetData = rst.Fields(0) 'Берём заказанное значение
    If IsNull(GetData) = True Then GetData = vDefault

GetData_Bye:
    On Error Resume Next
    rst.Close: Set rst = Nothing
    Exit Function

GetData_Err:
    GetData = vDefault: Err.Clear: Resume GetData_Bye
End Function


Примеры:

Dim v As Variant
    'Вернёт текст содержащий код и название через тире с пробелами
    v = GetData("Код_Товара & ("" - "" + Название_Товара)", "Справочник_Товаров", "Товар_ID=33", "Не Найдено!")
    
    v = GetData("Max(DetID)", "dtDet", 0) + 1 'Вернёт номер ключа для добавления новой записи



То же самое, но на ADO

Public Function GetData(sExpression$, sSourse$, Optional vCriteria As Variant = Null, _
        Optional vDefault As Variant = Null, _
        Optional vOptions As Variant = Null) As Variant
'--------------------------------------------------------------------
'es 14.12.2016 : LE 12.08.2019 : v002 : msa.polarcom.ru
'Возвращает:
'   Значение (выражения) указанное в sExpression из таблицы или запроса указанного в sSourse
'   по условиям отбора указанным в vCriteria (Опционально)
'При ошибке или отсутствии данных в источнике - Вернет значение  указанное в vDefault (Null)
'--------------------------------------------------------------------
'Аргументы:
'    sExpression - Название поля или Выражение с его участием (для SELECT ...)
'    sSource     - Название источника данных (Откуда?!) - имя Таблицы или Запроса
'    vCriteria   - Критерии отбора записей для WHERE ...
'    vDefault    - Значение возврвщаемое если искомое не найдено (или = Null)
'    vOptions    - Поле и Порядок сортировки (Типа: "ORDER BY ..." или "DESC" и т.п.)
'--------------------------------------------------------------------
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sSql$
'--------------------------------------------------------------------
On Error GoTo GetData_Err
    Set cnt = CurrentProject.Connection ' Локально
    cnt.CursorLocation = 2 'adUseServer (2) - adUseClient (3)
    Set rst = CreateObject("ADODB.Recordset")
    rst.CursorLocation = 2 'adUseServer (2) - adUseClient (3)
    
    sSql = "SELECT " & sExpression & " FROM " & sSourse & (" WHERE " + vCriteria) & (" " + vOptions)
    rst.Open sSql, cnt, adOpenStatic, adLockReadOnly
    
    GetData = rst.Fields(0) 'Берём заказанное значение
    If IsNull(GetData) = True Then GetData = vDefault

GetData_Bye:
    On Error Resume Next
    rst.Close: Set rst = Nothing
    cnt.Close: Set cnt = Nothing
    Exit Function

GetData_Err:
    GetData = vDefault: Err.Clear: Resume GetData_Bye
End Function
Назад ToTop
L.E. 12.08.2019
Рейтинг@Mail.ru