Append-запрос из VBA запускается также, как и обычный запрос:
DoCmd.OpenQuery "QueryName"
Для выключения всплывающего окна для подтверждения запроса, нужно выключить крыжик в меню: Файл --> Параметры --> Параметры клиента --> Подтверждение запросов на изменение:
Если Append-запрос запустить командой
DoCmd.OpenQuery "QueryName"
то в случае ошибки Access выдаст сообщение о невозможности выполнить запрос, например, по причине неуникальности ключа (повторы в ключевых полях или нарушение Integrity):
Ответ Yes означает выполнить запрос, игнорируя ошибку (т.е. в таблицу будут добавлены только те записи, которые подлежат данному правилу ключа); ответ No – не выполнять запрос. Не самое внятное сообщение об ошибке с точки зрения пользователя, если он просто пытается ввести одни и те же данные дважды…
Запускаем Append-запрос (см. запустить запрос на VBA) и если ни одна запись по нашему запросу не прошла, информируем, что запрос не прошел:
Sub RunAppendQuery()
Dim mydb As Database
Dim myquery As QueryDef
Set mydb = CurrentDb()
Set myquery = mydb.QueryDefs("AppendQueryName")
On Error GoTo Err 'в данном случае обрабатываем ошибку при выполнении запроса (Execute)
'myquery.Parameters('[Forms]![Form1]![TextBox1]') = [Forms]![Form1]![TextBox1] ' – если есть параметры/критерии в запросе
myquery.Execute
If myquery.RecordsAffected = 0 Then 'если ни одна запись не была добавлена, тогда:
GoTo Err
End If
Exit Sub
Err:
Msgbox "Запрос не прошел", vbExclamation, "Ошибка"
End Sub
А что если часть записей все-таки прошла, а часть нет? Ведь в таком случае .RecordsAffected не равен нулю...
Если это важно, можно сравнить общее количество запрашиваемых записей со значением .RecordsAffected. Если равны – запрос выполнен стопроцентно, не равны – знаем, что какие-то записи не были добавлены и тогда можно транзакцию откатить. См.: начать транзакцию.
"Общее количество запрашиваемых записей" можно уточнить следующим образом:
- через DAO создать запрос на выборку (SelectQueryName), идентичный запросу на добавление (AppendQueryName). См.: создание запроса DAO;
- используя Recordset, уточнить количество записей в запросе SelectQueryName;
- после запуска запроса AppendQueryName через Recordset (.Execute), сравнить .RecordsAffected с количеством записей SelectQueryName;
- если не совпадают: сообщение об ошибке, + возможность вернуть транзакцию;
- созданный запрос на выборку для проверки записей (SelectQueryName) удалить. См.: удаление запроса (DAO).
Пример:
Sub RunAppendQuery_2()
Dim db As Database, CheckQry As QueryDef, AppendQry As QueryDef, rst As Recordset
Dim RightRecCount As Long 'сюда кладем кол-во записей из проверочного запроса
Dim AppendRecCount As Long 'сюда кладем кол-во записей, подлежащих добавлению
Dim DiffRecCount As Long 'сюда кол-во записей, не подлежащих добавлению
On error GoTo Err
Set db = CurrentDb
'создаем проверочный запрос на выборку (все записи для добавления)
Set CheckQry = db.CreateQueryDef("SelectQueryName", "SELECT Data_temp.* FROM Data_temp;")
'количество записей проверочного запроса
RightRecCount = GetRecordCount_Query("SelectQueryName")
'Append запрос
Set AppendQry = db.QueryDefs("AppendQueryName")
'запустить Append запрос (пройдут все подлежащие добавлению записи!)
AppendQry.Execute
'кол-во подлежащих добавлению записей
AppendRecCount = AppendQry.RecordsAffected
'кол-во записей, которые не прошли запросом Append
Diff = RightRecCount - AppendRecCount
'удалить проверочный запрос
CurrentDb.QueryDefs.Delete "SelectQueryName"
'если нисколько записей не прошло по запросу
If AppendRecCount = 0 Then
MsgBox "Запрос не прошел", vbExclamation, "Ошибка"
Exit Sub
End If
'если сколько-то записей не прошло по запросу
If RightRecCount <> AppendQry.RecordsAffected Then
MsgBox "Какие-то записи запроса (в количестве " & Diff & ") не прошли", vbExclamation, "Ошибка"
Exit Sub
End If
Exit Sub
Err:
If QueryExists("SelectQueryName") then CurrentDb.QueryDefs.Delete "SelectQueryName" End If
ShowError 'Public Sub ShowError() -- ниже
End Sub
Function QueryExists(QueName As String) As Boolean
Dim que As AccessObject
'объявляем всегда когда работаем с объектами БД
For Each que In CurrentData.AllQueries
'используем CurrentData, т.к. работаем с таблицами. То же относится и к таблицам
If que.Name = QueName Then
QueryExists = True
Exit Function
End If
Next
QueryExists = False
End Function
Public Sub ShowError() 'показывает ошибку программы
MsgBox err.Description, vbCritical, err.Source
End Sub
Function GetRecordCount_Query(QueryName As String)
Dim mydb As Database 'работаем с базой данных
Dim qry As QueryDef 'работаем с запросом базы данных
Dim rst As Recordset 'запускаем запрос с помощью Recordset
'указываем текущую базу данных (здесь можно указать также путь к другой БД)
Set mydb = CurrentDb()
'указываем запрос
Set qry = mydb.QueryDefs(QueryName)
'открываем запрос SelectQueryName, получаем Recordset с результатами
Set rst = qry.OpenRecordset
If rst.EOF = False Then 'если в rst записи есть
'EOF - End Of File, BOF - Begin Of File
'EOF = True или BOF = False означает, что Recordset пуст (нет записей)
rst.MoveLast 'перейти на последнюю запись
GetRecordCount_Query = rst.RecordCount
Else
GetRecordCount_Query = 0
End If
End Function