Sunday 24 June 2012

Ex23: VBA - Execute SQL using DAO

Execute the SQL statement on the current database in a transaction using DAO in VBA

Option Compare Database
Option Explicit

'Constants for examining how a field is indexed.
Private Const intcIndexNone As Integer = 0
Private Const intcIndexGeneral As Integer = 1
Private Const intcIndexUnique As Integer = 3
Private Const intcIndexPrimary As Integer = 7


Public Function ExecuteInTransaction(strSql As String, Optional strConfirmMessage As String) As Long
On Error GoTo Err_Handler
    'Purpose:   Execute the SQL statement on the current database in a transaction.
    'Return:    RecordsAffected if zero or above.
    'Arguments: strSql = the SQL statement to be executed.
    '           strConfirmMessage = the message to show the user for confirmation. Number will be added to front.
    '           No confirmation if ZLS.
    '           -1 on error.
    '           -2 on user-cancel.
    Dim ws As DAO.Workspace
    Dim db As DAO.Database
    Dim bInTrans As Boolean
    Dim bCancel As Boolean
    Dim strMsg As String
    Dim lngReturn As Long
    Const lngcUserCancel = -2&
    
    Set ws = DBEngine(0)
    ws.BeginTrans
    bInTrans = True
    Set db = ws(0)
    db.Execute strSql, dbFailOnError
    lngReturn = db.RecordsAffected
    If strConfirmMessage <> vbNullString Then
        If MsgBox(lngReturn & " " & Trim$(strConfirmMessage), vbOKCancel + vbQuestion, "Confirm") <> vbOK Then
            bCancel = True
            lngReturn = lngcUserCancel
        End If
    End If
    
    'Commmit or rollback.
    If bCancel Then
        ws.Rollback
    Else
        ws.CommitTrans
    End If
    bInTrans = False

Exit_Handler:
    ExecuteInTransaction = lngReturn
    On Error Resume Next
    Set db = Nothing
    If bInTrans Then
        ws.Rollback
    End If
    Set ws = Nothing
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ExecuteInTransaction()"
    lngReturn = -1
    Resume Exit_Handler
End Function

No comments:

Post a Comment