Выполнение запросов в транзакции
Const ME_NAME = "Выполнение запросов в транзакции"
Global FORM_WITH_TRANS As Form
Public Function ExecuteTrans(STATUS_STRING As String, queries() As String, Optional ClearStatusString As Boolean = True, _
Optional WithoutTrans As Boolean = False) As Boolean
Static ACTIVE As Boolean
Dim L As Integer, U As Integer, c As Integer, i As Integer
Dim wsp As Workspace, dbs As Database, on_transaction As Boolean
Dim s As String
Dim qa As String
On Error GoTo ErrHandler
ExecuteTrans = False
If Not CheckVersion() Then Exit Function
L = LBound(queries)
U = UBound(queries)
c = U - L + 1
If c < 1 Then Exit Function
If ACTIVE Then
OpenForm "Сообщение_F", , , , , acDialog, "Не завершено выполнение" & vbNewLine & "предыдущей операции", , False
Exit Function
End If
ACTIVE = True
DoCmd.Hourglass True
If Not WithoutTrans Then
Set wsp = DBEngine.Workspaces(0)
wsp.IsolateODBCTrans = True
wsp.BeginTrans
on_transaction = True
End If
Set dbs = CurrentDb
For i = L To U
SysCmd acSysCmdInitMeter, STATUS_STRING & "..." & i & "/" & c, c
SysCmd acSysCmdUpdateMeter, i
If queries(i) <> "" Then dbs.Execute queries(i), dbFailOnError
DoEvents
Next i
If Not WithoutTrans Then
wsp.CommitTrans dbForceOSFlush
on_transaction = False
End If
ExecuteTrans = True
'обновление активности после выполнения транзакции
qa = "UPDATE Активные_пользователи SET Активные_пользователи.TRANSACT_LAST = Now()" & vbNewLine
qa = qa & "WHERE KOD_USER = " & DLookup("KOD_USER", gWORK_PLACE) & " AND COMP=" & DLookup("NUM_COMPUTER", gWORK_PLACE)
dbs.Execute qa
ExitFunction:
If ClearStatusString Then SysCmd acSysCmdClearStatus: DoCmd.Hourglass False
ACTIVE = False
Exit Function
ErrHandler:
If on_transaction Then wsp.Rollback
DoCmd.Hourglass False
ACTIVE = False
Select Case Err.NUMBER
Case 3022 'Нарушение уникальности индекса
OpenForm "Сообщение_F", , , , , acDialog, "Нарушение уникальности индекса" & vbNewLine & "Запрос№" & i & ": " & queries(i), , False
Case 3167 'Запись удалена
OpenForm "Сообщение_F", , , , , acDialog, _
"Не удалось провести изменения из-за" & vbNewLine & _
"конфликта с изменениями другого" & vbNewLine & _
"пользователя!" & vbNewLine & _
"Попробуйте внести изменения еще раз!" & vbNewLine & "Запрос№" & i & ": " & queries(i), , False
Case 3200 'Удаление или изменение записи невозможно. В таблице '$' имеются связанные записи.
OpenForm "Сообщение_F", , , , , acDialog, _
"Изменение невозможно!" & vbNewLine & _
"Ведет к нарушению целостности данных!" & vbNewLine & "Запрос№" & i & ": " & queries(i), , False
Case 3218, 3260 'Обновление невозможно; блокировка установлена пользователем '$' на машине '$'.
OpenForm "Сообщение_F", , , , , acDialog, _
"Не удалось провести изменения в" & vbNewLine & _
"документе, так как в данный момент" & vbNewLine & _
"выполняется обработка данных на" & vbNewLine & _
"другом компьютере!" & vbNewLine & _
"Подождите немного и попробуйте внести" & vbNewLine & _
"изменения еще раз!" & vbNewLine & "Запрос№" & i & ": " & queries(i), , False
Case 3265 'Item not found in this collection
OpenForm "Сообщение_F", , , , , acDialog, "Нет такого запроса: " & vbNewLine & queries(i), , False
Case 3316 'Товар_остатки_подробно
OpenForm "Сообщение_F", , , , , acDialog, _
"Операция не может быть выполнена!" & vbNewLine & _
Err.DESCRIPTION
Case 3035 'Недостаточно системных ресурсов
OpenForm "Сообщение_F", , , , , acDialog, _
"Недостаточно системных ресурсов!" & vbNewLine & vbNewLine & _
"Попробуйте изменить условия отбора," & vbNewLine & _
"чтобы уменьшить объем формируемых данных.", , False
Case Else
s = "Сообщите разработчику программы" & vbNewLine & Err.NUMBER & ": " & Err.DESCRIPTION
If Not IsEmpty(queries) Then s = s & vbNewLine & "Запрос №" & i & ": " & queries(i)
OpenForm "Сообщение_F", , , , , acDialog, s, , False
End Select
SysCmd acSysCmdClearStatus
Exit Function
Resume
End Function
Public Function isNothing(V As Object) As Boolean
isNothing = (TypeName(V) = "Nothing")
End Function