Механическое удерживание земляных масс: Механическое удерживание земляных масс на склоне обеспечивают контрфорсными сооружениями различных конструкций...
Папиллярные узоры пальцев рук - маркер спортивных способностей: дерматоглифические признаки формируются на 3-5 месяце беременности, не изменяются в течение жизни...
Топ:
Особенности труда и отдыха в условиях низких температур: К работам при низких температурах на открытом воздухе и в не отапливаемых помещениях допускаются лица не моложе 18 лет, прошедшие...
Эволюция кровеносной системы позвоночных животных: Биологическая эволюция – необратимый процесс исторического развития живой природы...
Теоретическая значимость работы: Описание теоретической значимости (ценности) результатов исследования должно присутствовать во введении...
Интересное:
Инженерная защита территорий, зданий и сооружений от опасных геологических процессов: Изучение оползневых явлений, оценка устойчивости склонов и проектирование противооползневых сооружений — актуальнейшие задачи, стоящие перед отечественными...
Как мы говорим и как мы слушаем: общение можно сравнить с огромным зонтиком, под которым скрыто все...
Лечение прогрессирующих форм рака: Одним из наиболее важных достижений экспериментальной химиотерапии опухолей, начатой в 60-х и реализованной в 70-х годах, является...
Дисциплины:
2017-12-12 | 219 |
5.00
из
|
Заказать работу |
|
|
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
|
|
Эмиссия газов от очистных сооружений канализации: В последние годы внимание мирового сообщества сосредоточено на экологических проблемах...
Механическое удерживание земляных масс: Механическое удерживание земляных масс на склоне обеспечивают контрфорсными сооружениями различных конструкций...
Общие условия выбора системы дренажа: Система дренажа выбирается в зависимости от характера защищаемого...
Таксономические единицы (категории) растений: Каждая система классификации состоит из определённых соподчиненных друг другу...
© cyberpedia.su 2017-2024 - Не является автором материалов. Исключительное право сохранено за автором текста.
Если вы не хотите, чтобы данный материал был у нас на сайте, перейдите по ссылке: Нарушение авторских прав. Мы поможем в написании вашей работы!