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

Создание запроса кодом VBA

Private Sub OpenSQLStringAsQuery(sQueryName$, sSQL$, Optional blnOpenAfter As Boolean)
' Создание запроса из SQL строки с последующим его открытием (опционально)
 ' -------------------------------------------------------------------------------------------------/
Dim qdf As QueryDef
Dim blnQueryExists As Boolean
    
' Проверка на существование запроса с указанным в аргументе названием
    For Each qdf In CurrentDb.QueryDefs
        If qdf.Name = sQueryName Then
            blnQueryExists = True ' Запрос существует!
        End If
    Next qdf
    
    If blnQueryExists Then
        If CurrentData.AllQueries(sQueryName).IsLoaded Then ' Проверка не открыт ли?
            DoCmd.Close acQuery, sQueryName
            blnOpenAfter = True
            Exit For
        End If
        Set qdf = CurrentDb.QueryDefs(sQueryName)
    Else
        Set qdf = CurrentDb.CreateQueryDef(sQueryName)      ' Создание запроса
    End If

    qdf.SQL = sSQL 'Задаём SQL "тело" запроса

' Открытие запроса на просмотр (если заказано в blnOpenAfter)
    If blnOpenAfter Then DoCmd.OpenQuery sQueryName, acViewNormal
    Set qdf = Nothing
End Sub



Ещё вариант по кнопке в форме:

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

Private Sub Кнопка3_Click() 'Процерура на Событие формы: Щелчёк по кнопке "Кнопка3" в форме
Dim sSQLString As String      'Переменная для "тела" запроса
Dim qdf As DAO.QueryDef       'Переменная объекта запроса
Dim blnQueryExists As Boolean 'Существует ли запрос (уже)
'Константа = Имя запроса: 
Const sQueryName As String = "Самый молодой сотрудник" 
 
'Формируем SQL тело запроса
    sSQLString = "SELECT TOP 1 ФИО, Возраст, [Наименование подразделения]" & vbCrLf & _
        "FROM Подразделения" & vbCrLf & _
        "INNER JOIN Сотрудники ON Подразделения.Код = Сотрудники.[ИД подразделения]" & vbCrLf & _
        "ORDER BY Возраст;"
 
' Проверка на существование запроса с указанным  названием
    For Each qdf In CurrentDb.QueryDefs ' Ищем в коллекции всех запросов БД
        If qdf.Name = sQueryName Then   ' Нашли!
            blnQueryExists = True       ' Отметка = Запрос существует!
            Exit For
        End If
    Next qdf
    
    If blnQueryExists Then 'Запрос уже существует
        If CurrentData.AllQueries(sQueryName).IsLoaded Then ' Проверка не открыт ли?
            DoCmd.Close acQuery, sQueryName                 ' Открыт = Закрываем ...
        End If
        Set qdf = CurrentDb.QueryDefs(sQueryName)
    Else
        Set qdf = CurrentDb.CreateQueryDef(sQueryName)      ' Создание запроса
    End If
 
    qdf.SQL = sSQLString 'Задаём SQL "тело" запроса
 
' Открытие запроса на просмотр
    DoCmd.OpenQuery sQueryName, acViewNormal
    Set qdf = Nothing
 
End Sub 'Конец процедуры
Назад ToTop
L.E. 09.04.2024
Рейтинг@Mail.ru