Microsoft Access modSql

Constants

Public Const strFormatSqlDate As String = "yyyy\-mm\-dd"
Public Const strFormatSqlDateCriterion As String = "\#yyyy\-mm\-dd\#"

executeSql

Public Function executeSql(strSql As String) As Long
    Dim lngResult As Long
    
    Const strFormatHms As String = "hh:mm:ss"
    
    Dim datStart As Date
    Dim strErr As String
    Dim strTable As String
    Dim strAffected As String
    
    lngResult = 0
    
    If isDebug Then
        Debug.Print "----------------------------------------"
        Debug.Print strSql
        Debug.Print
        datStart = Now
        Debug.Print "Start      : " & Format(datStart, strFormatHms)
    End If

    With CurrentDb
        'DoCmd.SetWarnings False
        On Error GoTo handleExecuteError
        If isDebug Then
            .Execute strSql, dbFailOnError
        Else
            .Execute strSql
        End If
        On Error GoTo 0
        'DoCmd.SetWarnings True
        DoEvents
        
        strAffected = "Records    "
        Select Case .RecordsAffected
        Case 1
            'Last inserted id
            lngResult = .OpenRecordset("SELECT @@IDENTITY")(0)
            If lngResult = 0 Then
                lngResult = 1
            Else
                strAffected = "Last Id    "
            End If
        Case Else
            'Number of affected records
            lngResult = .RecordsAffected
        End Select
    End With
    
    If isDebug Then
        Debug.Print "End        : " & Format(Now, strFormatHms)
        Debug.Print "             " & "--------"
        Debug.Print "Duration   : " & Format(Now - datStart, strFormatHms)
        Debug.Print strAffected & ": " & Format(lngResult, "#,##0")
        Debug.Print "----------------------------------------"
        Debug.Print
    End If

    executeSql = lngResult
    Exit Function
    
handleExecuteError:
    'On Error GoTo handleExecuteSqlErrorFinal
    'DoCmd.RunSQL strSql
    'On Error GoTo 0
    'resume next
    'handleExecuteSqlErrorFinal:

    Select Case Err.Number
    
    Case 3010:
        'Table already exists
        strErr = Err.Description
        strTable = Mid( _
            Err.Description, _
            InStr(1, strErr, "'", vbTextCompare) + 1, _
            InStrRev(strErr, "'", -1, vbTextCompare) - _
                InStr(1, strErr, "'", vbTextCompare) - 1 _
            )
        DoCmd.Close acTable, strTable, acSaveNo
        DoCmd.DeleteObject acTable, strTable
        Resume
    
    Case 2008:
        'Table is open
        DoCmd.Close acTable, strTable, acSaveNo
        Resume
    
    Case 3022:
        'LockOut
        Debug.Print Now & " - trying again ..."
        DoEvents
        Resume
    
    Case Else
        strErr = Err.Number & " : " & Err.Description
        Debug.Print "########################################"
        Debug.Print "# ERR " & Err.Number & " : " & Err.Description
        Debug.Print "# ABORT"
        Debug.Print "########################################"
        Debug.Print
        If isDebug Then
            Stop
        End If
    
    End Select
End Function

showSqlResult

Public Sub showSqlResult(strSql As String, Optional strQuery As String = "")
    Dim dbs As Database
    Dim qdf As QueryDef
    
    If strQuery = "" Then
        strQuery = "SQL Result"
    End If
    If existsQuery(strQuery) Then
        DoCmd.DeleteObject acQuery, strQuery
    End If
    Set dbs = CurrentDb
    Set qdf = dbs.CreateQueryDef(Name:=strQuery, SQLText:=strSql)
    DoCmd.OpenQuery strQuery
    Do While CurrentData.AllQueries(strQuery).IsLoaded
        DoEvents
    Loop
    DoCmd.DeleteObject acQuery, strQuery
End Sub

getSqlAmount

Public Function getSqlAmount(cur As Currency) As String
    Dim strResult As String
    
    strResult = CStr(cur)
    strResult = Replace( _
        Expression:=strResult, _
        Find:=",", _
        Replace:=".", _
        Compare:=vbTextCompare _
        )
    
    getSqlAmount = strResult
End Function

getSqlDate

Public Function getSqlDate(dat As Date) As String
    Dim strResult As String
    
    strResult = Format(dat, strFormatSqlDate)
    
    getSqlDate = strResult
End Function

getSqlDateCriterion

Public Function getSqlDateCriterion(dat As Date) As String
    Dim strResult As String
    
    strResult = Format(dat, strFormatSqlDateCriterion)
    
    getSqlDateCriterion = strResult
End Function