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, Optional strDatabase As String = "") As Long
    Dim lngResult As Long
 
    Const strFormatHms As String = "hh:mm:ss"
    
    Dim db As Database
    Dim datStart As Date
    Dim strErr As String
    Dim strTable As String
    Dim strAffected As String
    Dim strResult As String
 
    lngResult = 0
 
    If isDebug Then
        Debug.Print "----------------------------------------"
        Debug.Print strSql
        datStart = Now
        Debug.Print "+---------------------+"
        Debug.Print "|    Start : " & Format(datStart, strFormatHms) & " |"
    End If
    
    If strDatabase = "" Or strDatabase = CurrentProject.FullName Then
        Set db = CurrentDb
    Else
        Set db = OpenDatabase(strDatabase)
    End If
    
    With db
        On Error GoTo handleExecuteError
        If isDebug Then
            .Execute strSql, dbFailOnError
        Else
            .Execute strSql
        End If
        On Error GoTo 0
        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
        strResult = Format(lngResult, "#,##0")
        If Len(strResult) < 8 Then
            strResult = strResult & Space(8 - Len(strResult) + 1) & "|"
        End If
        Debug.Print "|      End : " & Format(Now, strFormatHms) & " |"
        Debug.Print "| Duration : " & Format(Now - datStart, strFormatHms) & " |"
        Debug.Print strAffected & ": " & strResult
        Debug.Print "+---------------------+"
        Debug.Print "----------------------------------------"
        Debug.Print
    End If
 
    executeSql = lngResult
    Exit Function
 
handleExecuteError:
    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 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