Microsoft Access modSql

Constants

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

executeSql

SQL statements with references to Access objects would work with DoCmd.RunSQL but the use of references to form fields and other Access objects is not advisable, therefore this option for handling possible errors has deliberately been omitted.

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
            Resume
        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