Выполнение запросов в транзакции

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