Wandelt einen Wert in die SQL-Scrheibweise. Gut für Filter und Where-Bedinungen einer Abfrage

Download cast_tosqlstr.bas (V-1.0.0)

Diese Funktion castet verschiedene Typen in das SQL-Format. Im Gegensatz zu BuildCriteria() von VBA, wird hier kein Vergleichsfeld benötigt.

Public Function toSqlStr( _
    ByVal iDataType As DataTypeEnum, _
    ByVal iItem As Variant, _
    Optional ByVal iParams As sqlStrParams = sqlStrParams.[_Default], _
    Optional ByVal iNullDefault As Variant = Null _
) As String

• iDataType Type des Feldes
• iItem Wert oder Array von Werten
• iParams Nur zuDebugzwecken zu empfehlen. Im Fehlerfall belicht der Parser stehen
• iNullDefault Wert, falls iItem Null ist und sspNullToEmpty nicht gesetzt ist

• Return Formatierter Wert oder eine Liste mit den Formatierten Werten

Public Enum sqlStrParams
    sspIsNullable = 2 ^ 0                   'Das Feld darf Null sein
    sspNullToEmpty = 2 ^ 1                  'Im Null-Fall Emptyverwenden
    sspOnErrorAssert = 2 ^ 5                'Bei einem Fehler den Code unterbrechen
    sspOnErrorReturnError = 2 ^ 6           'Bei einem Fehler diesen als Wert ausgeben
    sspOnErrorReturnNull = 2 ^ 7            'Bei einem Fehler den Wert als Null behandeln
    [_Default] = sspOnErrorReturnError + sspIsNullable
End Enum

?toSqlStr(dbText, "ABC")
'ABC'
 
?toSqlStr(dbNumeric, 123)
123

Vergleich der verschiedenen Datumsausgaben

' Nur das Datum
?toSqlStr(dbDate, now)
#03/27/2017#
 
' Datum & Zeit
?toSqlStr(dbTimeStamp, now)
#03/27/2017 12:43:22#
 
' Nur die Zeit
?toSqlStr(dbTime, now)
#12:43:22#

Wenn man nicht einfach dbNumber nimmt sondern sich spezifisch festlegt, wird eine Konvertierung mit möglichen Fehlern ausgeführt

' Einfache Nummer
?toSqlStr(dbNumeric, 123456.78)
123456.78
 
'als Long. DieNachkommastellen gehen verloren (analog zu cLng())
?toSqlStr(dbLong, 123456.78)
123457
 
'Die Nummer ist zu gross für einen Integer
?toSqlStr(dbInteger, 123456.78)
#Overflow

Null ist immer wieder ien Spezialfall. Standardmässig wird Null in den Text Null gewandelt. Um den Unterschied zu zeigen verwende ich hier die Ausgabe über [VBA] print_r().

' So sieht die Ausgabe von print_r für Null aus
d Null
<Null> 
 
'toSqlString wandelt das in den Text NULL, der so von SQL verstanden wird
d toSqlStr(dbNumeric, Null)
<String> 'NULL'
 
'Mit wird definiert, dass anstelle von 0 Empty verwendet werde soll
? toSqlStr(dbNumeric, Null, sspNullToEmpty)
0
? toSqlStr(dbText, Null, sspNullToEmpty)
''

Wird ein iNullDefault mitgegeben, dann übersteuert dieser die Parameters, Das funktioniert dann analog zu einem NZ()

? toSqlStr(dbNumeric, 99,, 11)
99
 
? toSqlStr(dbNumeric, Null,, 11)
11
 
'sspNullToEmpty wird ignoriert, da ein iNullDefault gesetzt ist
? toSqlStr(dbNumeric, Null, sspNullToEmpty, 11)
11

Für Boolean wird cBool zum Konvertieren verwendet

d toSqlStr(dbBoolean, 1=1)
<String> 'TRUE'

d toSqlStr(dbBoolean, "False")
<String> 'FALSE'

Bei einem Array wird das Format auf alle Elemente angewendet und das Result erscheint als List, die in einem SQL für IN() verwendet werden kann

? toSqlStr(dbLong, array(13,14,"16"))
13,14,16
 
? toSqlStr(dbText, array("a", "b", "c"))
'a','b','c'
 
? toSqlStr(dbDate, array(now, now+1))
#03/27/2017#,#03/28/2017#
 
? toSqlStr(dbLong, array(13,"ABC","16", NULL))
13,#TypeMismatch,16,NULL

Als Standard wird einFeulertext ausgegeben

? toSqlStr(dbLong, "abc")
#TypeMismatch
 
'sspOnErrorReturnError ist der Default-Parameter
? toSqlStr(dbLong, "abc", sspOnErrorReturnError)
#TypeMismatch
 
'Es kann auch einfach der Wet durch Null ersetzt werden.
? toSqlStr(dbLong, "abc", sspOnErrorReturnNull)
Null
 
'Beim folgenden Aufruf wird die Verarbeitung angehalten und der es wird in den Debug-Mode gewechselt
? toSqlStr(dbLong, "abc", sspOnErrorAssert)

Und jetzt mal angewendet:

    Dim sql As String
    Dim fromDate As Date, toDate As Date
    Dim flags() As Variant
 
    fromDate = Now - 10
    toDate = Now
    flags = Array("a", "u", "k")
 
    sql = "SELECT * FROM myTable WHERE " & _
        " flag in (" & toSqlStr(dbText, flags) & ") " & _
        "AND my_date BETWEEN " & toSqlStr(dbDate, fromDate) & " AND " & toSqlStr(dbDate, toDate)
 
    Debug.Print sql

SELECT * FROM myTable WHERE  flag IN ('a','u','k') AND my_date BETWEEN #03/17/2017# AND #03/27/2017#

cast_tosqlstr.bas

Attribute VB_Name = "cast_toSqlStr"
Option Compare Database
'-------------------------------------------------------------------------------
'File         : cast_toSqlStr.bas
'               Copyright mpl by ERB software
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/tosqlstr
'Environment  : VBA 2007 +
'Version      : 1.0.0
'Author       : Stefan Erb (ERS)
'Description  : Parst ein Wert in die SQL-Schreibform
'History      : 27.03.2017 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit
 
Public Enum sqlStrParams
    sspIsNullable = 2 ^ 0                   'Das Feld darf Null sein
    sspNullToEmpty = 2 ^ 1                  'Im Null-Fall Emptyverwenden
    sspOnErrorAssert = 2 ^ 5                'Bei einem Fehler den Code unterbrechen
    sspOnErrorReturnError = 2 ^ 6           'Bei einem Fehler diesen als Wert ausgeben
    sspOnErrorReturnNull = 2 ^ 7            'Bei einem Fehler den Wert als Null behandeln
    [_Default] = sspOnErrorReturnError + sspIsNullable
End Enum
 
'/**
' * gibt den Value oder Feldnamen zurück
' * @param  DataTypeEnum    Type des Feldes
' * @param  Variant         Wert oder Array von Werten
' * @param  sqlStrParams    Steuerparameters
' * @param  Variant         Wert, falls iItem Null ist und sspNullToEmpty nicht gesetzt ist
' * @return String          Formatierter Wert oder eine Liste mit den Formatierten Werten
' */
Public Function toSqlStr( _
    ByVal iDataType As DataTypeEnum, _
    ByVal iItem As Variant, _
    Optional ByVal iParams As sqlStrParams = sqlStrParams.[_Default], _
    Optional ByVal iNullDefault As Variant = Null _
) As String
    'Spezialfall. Der String wird nicht geparst
On Error GoTo Err_Handler
    'Liste Auswerten
    If IsArray(iItem) Then
        Dim ret() As String: ReDim ret(LBound(iItem) To UBound(iItem))
        Dim i As Long: For i = LBound(iItem) To UBound(iItem)
            ret(i) = toSqlStr(iDataType, iItem(i), iParams, iNullDefault)
        Next i
        toSqlStr = Join(ret, ", ")
        Exit Function
    End If
 
    'Spezialfall NULL
    If IsNull(iItem) Then
        If Not IsNull(iNullDefault) Then
            iItem = iNullDefault
        ElseIf andB(iParams, sspIsNullable) Then
            toSqlStr = "NULL"
            Exit Function
        ElseIf andB(iParams, sspNullToEmpty) Then
            iItem = Empty
        End If
    End If
 
    'Einzelwert formatieren
    Select Case iDataType
        Case dbNumeric:         toSqlStr = CStr(CDec(iItem))
        'Bei spezifizierten Nummern, zuerst zr Sicherheit konvertieren um zu prüfen ob die Zahl in das Format passt
        Case dbLong:            toSqlStr = CStr(CLng(iItem))
        Case dbInteger:         toSqlStr = CStr(CInt(iItem))
        Case dbByte:            toSqlStr = CStr(CByte(iItem))
        Case dbCurrency:        toSqlStr = CStr(CCur(iItem))
        Case dbDouble:          toSqlStr = CStr(CDbl(iItem))
        Case dbDecimal:         toSqlStr = CStr(CDec(iItem))
        Case dbSingle:          toSqlStr = CStr(CSng(iItem))
        Case dbDate:            toSqlStr = format(CDate(iItem), "\#mm\/dd\/yyyy\#")             'Nur Datum
        Case dbTimeStamp:       toSqlStr = format(CDate(iItem), "\#mm\/dd\/yyyy hh:nn:ss\#")    'Datum & Zeit
        Case dbTime:            toSqlStr = format(CDate(iItem), "\#hh:nn:ss\#")                 'Zeit
        Case dbBoolean:         toSqlStr = UCase((CBool(iItem)))                                'Booelan
        Case Else:              toSqlStr = "'" & CStr(iItem) & "'"                              'Strings und anderes
    End Select
    Exit Function
 
Err_Handler:
    If andB(iParams, sspOnErrorAssert) Then
        Debug.Print Err.number, Err.DESCRIPTION
        Debug.Assert False
    End If
    If andB(iParams, sspOnErrorReturnError) Then
        Select Case Err.number
            Case 6:     toSqlStr = "#Overflow"                'Overflow
            Case 13:    toSqlStr = "#TypeMismatch"            'Type Missmatch
            Case 438:   toSqlStr = "#TypeMismatch"            'Object doesn't support this property or method
            Case Else:  toSqlStr = "#Err_" & Err.number & "_" & Err.DESCRIPTION & " '"
        End Select
        Exit Function
    ElseIf andB(iParams, sspOnErrorReturnNull) Then
        toSqlStr = "Null"
        Exit Function
    End If
    toSqlStr = "'#Err " & Err.number & " " & Err.DESCRIPTION & " '"
End Function
 
'/**
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/andb
' * Macht einen Bit-Vergleich
' * @param  Long
' * @param  Long
' * @return Boolean
' */
Public Function andB(ByVal iHaystack As Long, ByVal iNeedle As Long) As Boolean
    andB = ((iHaystack And iNeedle) = iNeedle)
End Function