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