VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "TempTableDef"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : TempTableDef.cls
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/doku.php/vba/access/classes/temptabledef
'Environment  : VBA 2007+
'Version      : 1.2.2
'Name         : TempTableDef
'Author       : Stefan Erb (ERS)
'History      : 29.03.2017 - ERS - Creation
'               15.05.2017 - ERS - me als zusätzlicher Tabellennamenplatzhalter hinzugefügt
'               19.05.2017 - ERS - Diverse erweiterungen
'               12.06.2017 - ERS - :self und :me als Ersatzstring hinzugefügt
'               15.08.2017 - ERS - Korrektur, falls der Tabellenname und ein Feldname gleich heissen
'-------------------------------------------------------------------------------
Option Explicit

'-------------------------------------------------------------------------------
' -- Settings
'-------------------------------------------------------------------------------

'Die {$name} und {$user} sind Platzhalter und werden ersetzt
Private Const C_NAME_PREFIX = "#TMP_"                       'Prefix für den TemTableName    prefix & pattern
Private Const C_QUERY_PREFIX = "#QRY_"                      'Prefix für generierte QueryDefs
Private Const C_NAME_PATTERN = "{$name}"                    'Pattern ohne UserScope
Private Const C_NAME_PATTERN_USER = "{$user}_{$name}"       'Pattern bei UserScope
Private Const C_SINGLETON_NAME = "singleton"                'Name bei Singleton
Private Const C_PLACEHOLDERS = "{$name},me,self,tmp,temp"   'Mögliche Platzhalter,die durch den TemTableName ersetzt werden,

'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------

'/**
' * Settings
' */
Public Enum TempTableDefEnum
    ttdForceDrop = 2 ^ 1        'Beim löschen nicht nachfragen.
    ttdScopeUser = 2 ^ 4        'Dem physischen Tabellenname wird der User angehängt. Somit ist die TempTable Userabhängig
    ttdScopeClass = 2 ^ 5       'Die TempTable wird nur solange gehalten, solange die Klasse exisitiert
    [_Default] = ttdScopeUser + ttdScopeClass + ttdForceDrop
    [_Singleton] = ttdScopeUser + ttdForceDrop
End Enum

'-------------------------------------------------------------------------------
' -- Private Members
'-------------------------------------------------------------------------------
Private Type SettingType
    forceDrop As Boolean
    scopeUser As Boolean
    scopeClass As Boolean
End Type

Private pName           As String
Private pTempName       As String
Private pDb             As Database
Private pSettings       As SettingType
Private pUser           As String
Private pRxTblName      As Object
Private pParamters      As Object       'Dictionary

'-------------------------------------------------------------------------------
' -- Public Constructors
'-------------------------------------------------------------------------------
'/**
' * Erstellt eine neue Instanz und gibt diese zurück
' * @param  String              Name der Temp-Tabelle
' * @param  TempTableDefEnum    Settings
' * @return TempTableDef
' */
Public Function instance( _
        ByVal iName As String, _
        Optional ByVal iSettings As TempTableDefEnum = TempTableDefEnum.[_Default] _
) As TempTableDef
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
    Set instance = New TempTableDef
    instance.construct iName, iSettings
End Function

'/**
' * Initialisiert eine Instanz
' * @param  String              Name der Temp-Tabelle
' * @param  TempTableDefEnum    Settings
' * @return TempTableDef
' */
Public Function construct( _
        ByVal iName As String, _
        Optional ByVal iSettings As TempTableDefEnum = TempTableDefEnum.[_Default] _
) As TempTableDef
    name = iName
    pSettingsEnum = iSettings
    Set construct = Me
End Function

'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------

'/**
' * Erstellt die TempTable anhand von verscheidenen Quellen
' * ! Ist iSource ein SELECT unf hat im SELECT Teil Unterabfragen, dann funktioniert das NICHT
' * @param  QueryDef/Sql/RecordSet/TableDef/TableName/QueryName/SQLScript/TempTableDef
' * @param  Dictionary<Name> => Value       Parameters für Abfragen mit Paramtern
' * @return TempTableDef
' */
Public Function create(ByRef iSource As Variant, Optional ByRef iParamters As Object = Nothing) As TempTableDef
On Error GoTo Err_Handler

    Dim qdf As QueryDef
    Dim sql As String
    Select Case TypeName(iSource)
        Case "QueryDef":     sql = iSource.sql
        Case "String":       sql = iSource
        Case "Recordset2":   sql = iSource.name
        Case "TableDef":     sql = "SELECT * FROM [" & iSource.name & "]"
        Case "TempTableDef": sql = "SELECT * FROM " & iSource.tempNameSql
        Case "SQLScript":
            If iSource.action = saContainer Then
                Dim subscript As Object: For Each subscript In iSource
                    If subscript.action = saCreate And subscript.affectedType = soTable Then
                        create subscript, iParamters
                    ElseIf subscript.action = saInsert Or subscript.action = saInsertOnDuplicateUpdate Then
                        execute subscript, iParamters
                    End If
                Next subscript
                Exit Function
            ElseIf iSource.action = saCreate And iSource.affectedType = soTable Then
                sql = iSource.sql
            End If
    End Select
    
    'Select Statement. -> Ein select into erstellen
    If rxSelect.test(sql) Then
        'Wenn der SELECT bereits ein INTO besitzt, dann wird dieses ersetzt ($2 des Patterns)
        sql = rxSelect.Replace(sql, "$1 into " & tempNameSql & " $3")
    'Create Table
    ElseIf rxCreateTable.test(sql) Then
    Else
        Err.Raise vbObjectError, "TempTableDef.create", "Not valid select od create Table statement " & vbCrLf & sql
    End If
    Set qdf = queryDefWithParams(sql, iParamters)
    If exists Then drop
    qdf.execute
    qdf.Close
    Application.SetHiddenAttribute acTable, tempName, True
    
    Set create = Me
    Exit Function

Err_Handler:
    logError Err, "create"
    Exit Function
    Resume
End Function

'/**
' * Führt ein execute() durch und parst dabei den Tabellenname
' * siehe auch convertSql()
' * @param  QueryDef/Sql/RecordSet/TableDef/TableName/QueryName/SQLScript/TempTableDef
' * @param  Dictionary<Name> => Value       Parameters für Abfragen mit Paramtern
' * @return Long            affected Rows
' */
Public Function execute(ByRef iSource As Variant, Optional ByRef iParamters As Object = Nothing) As Long
On Error GoTo Err_Handler

    If TypeName(iSource) = "SQLScript" Then
        If iSource.action = saContainer Then
            Dim subscript As Object: For Each subscript In iSource
                execute subscript, iParamters
            Next subscript
            Exit Function
        End If
        execute iSource.sql
        Exit Function
    End If

    With queryDefWithParams(iSource, iParamters)
        .execute
        execute = .RecordsAffected
    End With
    Exit Function

Err_Handler:
    logError Err, "execute"
End Function

'/**
' * öffnet ein Recordset auf die TempTable
' * siehe auch convertSql()
' * @param  QueryDef/Sql/RecordSet/TableDef/TableName/QueryName/SQLScript/TempTableDef
' * @param  RecordsetTypeEnum
' * @param  RecordsetOptionEnum
' * @param  LockTypeEnum
' * @param  Dictionary<Name> => Value       Parameters für Abfragen mit Paramtern
' * @return Dao.Recordset
' */
Public Function openRecordset( _
        Optional ByRef iSource As Variant = Null, _
        Optional ByVal iType As Variant, _
        Optional ByVal iOptions As Variant, _
        Optional ByVal iLockEdit As Variant, _
        Optional ByRef iParamters As Object = Nothing _
) As DAO.Recordset
On Error GoTo Err_Handler
    
    If exists Then Set openRecordset = queryDefWithParams(iSource, iParamters).openRecordset(iType, iOptions, iLockEdit)
    Exit Function

Err_Handler:
    logError Err, "openRecordset"
End Function

'/**
' * Gibt die TempTable asl QueryDef zurück
' * @param  QueryDef/Sql/RecordSet/TableDef/TableName/QueryName/SQLScript/TempTableDef
' * @param  Dictionary<Name> => Value       Parameters für Abfragen mit Paramtern
' *
Public Function toQueryDef(Optional ByRef iSource As Variant = Null, Optional ByRef iParamters As Object = Nothing) As QueryDef
    Set toQueryDef = queryDefWithParams(iSource, iParamters)
End Function

'/**
' * öffnet und zeigt ein SQL als Abfrage
' * @param  QueryDef/Sql/RecordSet/TableDef/TableName/QueryName/SQLScript/TempTableDef
' * @param  Dictionary<Name> => Value       Parameters für Abfragen mit Paramtern
' * @param  String
' */
Public Sub showQuery(Optional ByRef iSource As Variant = Null, Optional ByRef iParamters As Object = Nothing)
On Error GoTo Err_Handler

    Dim qryName As String: qryName = parseNamePatterns(C_QUERY_PREFIX & IIf(scopeUser, C_NAME_PATTERN_USER, C_NAME_PATTERN)) & format(Now, "_YYYYMMDD_HHNNSS")
    
    queryDefWithParams iSource, iParamters, qryName
    'db.CreateQueryDef qryName, sql
 
    'Abfrage öffnen
    DoCmd.openQuery qryName
    'QueryDef wieder löschen
    db.QueryDefs.delete qryName

    Exit Sub

Err_Handler:
    logError Err, "openRecordset"
End Sub

'/**
' * Konvertiert in einem SQL den Name durch den tatsächlichen Tabellennamen
' * Als Platzhalter kann der definiere Name oder me verwednet werden
' * @example    debug.print TempTableDef.convertSql("select t.id from [me] t")  -->  select t.id from [#TMP_C754943_singleton] t
' * @param  String
' * @return String
' */
Public Function convertSql(ByVal iSql As String) As String
    convertSql = iSql
    'Leider muss das SQL umgekehrt werden, da VBA (?<!xy) nicht kennt. Dabei soll kein Tabellenneman der mit . beginnt ersetzt werden.
    'abc.abc -> #TMP.abc und nicht #TMP.#TMP
    If rxTblName.test(StrReverse(iSql)) Then convertSql = StrReverse(rxTblName.Replace(StrReverse(iSql), StrReverse(tempNameSql)))
End Function

Public Sub paramtersReset()
    pParamters.RemoveAll
End Sub

'/**
' * Löscht die physiche Tabelle
' */
Public Function drop(Optional ByVal iForce As Variant = Null) As Boolean
On Error GoTo Err_Handler

    'db.TableDefs.delete tempName
    If Not exists Then Err.Raise 337        'Component not found
    drop = True
    
    If Not NZ(iForce, forceDrop) Then drop = MsgBox("Delete temporary table " & name, vbQuestion + vbYesNo) = vbYes
    If drop Then pDb.execute "DROP TABLE " & tempNameSql
    Exit Function

Err_Handler:
    logError Err, "drop"
    drop = False
End Function

'/**
' * Löscht alle physiche Temp-Tabellen
' * Falls der Scope auf User gestellt ist, werden nur die TempTables des entsprechenen Users gelöscht
' */
Public Sub dropAllTempTables()
    Dim pattern As String: pattern = C_NAME_PREFIX & IIf(scopeUser, C_NAME_PATTERN_USER, C_NAME_PATTERN)
    pattern = parseNamePatterns(pattern, "*", "*")
    Dim sql As String:          sql = "select name from MSysObjects where type=1 and name like '" & pattern & "'"
    Dim rs As DAO.Recordset:    Set rs = db.openRecordset(sql)
    Do While Not rs.EOF
        db.execute "DROP TABLE [" & rs!name & "]"
        rs.MoveNext
    Loop
End Sub

'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------
'/**
' * Prüft ob die physische Tabelle exisitiert
' * @return Boolean
' */
Public Property Get exists() As Boolean
    Dim sql As String: sql = "select count(*) as cnt from MSysObjects where type=1 and name = '" & tempName & "'"
    exists = db.openRecordset(sql)!cnt > 0
End Property

'/**
' * Der physiche Name der Tabelle, wie sie in der DB angelegt wird
' * @return String
' */
Public Property Get tempName() As String
    If pTempName = Empty Then pTempName = parseNamePatterns(C_NAME_PREFIX & IIf(scopeUser, C_NAME_PATTERN_USER, C_NAME_PATTERN))
    tempName = pTempName
End Property
Public Property Get tempNameSql() As String:        tempNameSql = "[" & tempName & "]":         End Property

'/**
' * @return TableDef
' */
Public Property Get tableDef() As tableDef
    If exists Then Set tableDef = pDb.TableDefs(tempName)
End Property

'/**
' * @return String
' */
Public Property Get name() As String:               name = pName:                               End Property
Public Property Let name(ByVal iName As String)
    pName = iName
    pTempName = Empty
End Property

'/**
' * @return String
' */
Public Property Get user() As String:               user = pUser:                               End Property
Public Property Let user(ByVal iUser As String):    pUser = iUser:                              End Property

'/**
' * @return Database
' */
Public Property Get db() As Database:               Set db = pDb:                               End Property
Public Property Set db(ByRef iDb As Database):      Set pDb = iDb:                              End Property

'/**
' * Setzt eine SQL-Paramter. Datentyp: Variant, je nach Variable
' */
Public Property Let paramter(ByVal iName As String, ByVal iValue As Variant)
    Dim varName As String:  varName = UCase(iName)
    If Not paramters.exists(varName) Then
        paramters.add varName, iValue
    Else
        paramters(varName) = iValue
    End If
End Property
Public Property Get paramter(ByVal iName As String) As Variant
    Dim varName As String:  varName = UCase(iName)
    If paramters.exists(varName) Then
        paramter = paramters(varName)
    Else
        paramter = Null
    End If
End Property
'/**
' * Die SQL-Parameters/Variablen, die mit SET gesetzt wurden
' * @retrun Dictionary  Dict<Key> => Varaint
' */
Public Property Get paramters() As Object
    If pParamters Is Nothing Then Set pParamters = CreateObject("scripting.Dictionary")
    Set paramters = pParamters
End Property
Public Property Set paramters(ByRef iParamters As Object)
    If Not TypeName(iParamters) = "Dictionary" Then Err.Raise 13    'Type mismatch (Visual Basic)
    Set pParamters = iParamters
End Property

'/**
' * Die verschieden settings
' */
Public Property Get settings() As TempTableDefEnum:                 settings = pSettingsEnum:               End Property
Public Property Let settings(ByVal iSettings As TempTableDefEnum):  pSettingsEnum = iSettings:              End Property

Public Property Get forceDrop() As Boolean:                 forceDrop = pSettings.forceDrop:      End Property
Public Property Let forceDrop(ByVal iFlag As Boolean):      pSettings.forceDrop = iFlag:          End Property

Public Property Get scopeUser() As Boolean:                 scopeUser = pSettings.scopeUser:      End Property
Public Property Let scopeUser(ByVal iFlag As Boolean)
    pSettings.scopeUser = iFlag
    pTempName = Empty
End Property

Public Property Get scopeClass() As Boolean:                scopeClass = pSettings.scopeClass:    End Property
Public Property Let scopeClass(ByVal iFlag As Boolean)
    pSettings.scopeClass = iFlag
    pTempName = Empty
End Property

'-------------------------------------------------------------------------------
' -- Private Methodes
'-------------------------------------------------------------------------------
'/**
' * logt einen Error
' */
Private Sub logError(ByRef iErr As ErrObject, Optional ByVal iSource As String)
    Debug.Print Err.number, Err.DESCRIPTION, "TempTableDef." & iSource
End Sub

'/**
' * genereirt einen Tebllennamen
' * @param  String  Pattern
' * @param  String  Name
' * @param  String  User Name
' * @return String
Private Function parseNamePatterns(ByVal iPattern As String, Optional ByVal iName As Variant = Null, Optional ByVal iUser As Variant = Null)
    parseNamePatterns = iPattern
    parseNamePatterns = Replace(parseNamePatterns, "{$name}", NZ(iName, name))
    parseNamePatterns = Replace(parseNamePatterns, "{$user}", NZ(iUser, user))
End Function

'/**
' * Escapt Patterns für einen SQL Like
' * @param  String
' * @return String
' */
Private Function escapeLike(ByVal iString As String) As String
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/([\[\]\?\*\#])/i")
    escapeLike = rx.Replace(iString, "[$1]")
End Function

'/**
' * Temporäres QueryDef mit den Paramtern
' * @param  Variant     Quelle
' * @param  Variant     Name des QueryDef
' * @return QueryDef
' */
Private Function queryDefWithParams( _
        Optional ByVal iSource As Variant = Null, _
        Optional ByRef iParamters As Object = Nothing, _
        Optional ByVal iQueryName As Variant = Null _
) As QueryDef
On Error GoTo Err_Handler

    Dim qdf As QueryDef
    Dim lParamters As Object
    
    If iParamters Is Nothing Then
        Set lParamters = paramters
    ElseIf TypeName(iParamters) = "Dictionary" Then
        Set lParamters = iParamters
    Else
        Err.Raise 13    'Type Mismatch
    End If
SELECT_TYPE:
    Select Case TypeName(iSource)
        Case "QueryDef":        Set qdf = iSource
        Case "String":          If Trim(iSource) = Empty Then iSource = Null: GoTo SELECT_TYPE
                                Set qdf = db.CreateQueryDef(NZ(iQueryName), convertSql(iSource))
        Case "Recordset2":      Set qdf = iSource.OpenQueryDef
        Case "TableDef":        Set qdf = db.CreateQueryDef(NZ(iQueryName), "SELECT * FROM [" & iSource.name & "]")
        Case "TempTableDef":    Set qdf = iSource.QueryDef
        Case "Null":            Set qdf = db.CreateQueryDef(NZ(iQueryName), "SELECT * FROM " & tempNameSql)
        Case Else:              Err.Raise 13, "queryDefWithParams"
    End Select
    
    Dim paramsUBound As Long: paramsUBound = -1
    On Error Resume Next
    paramsUBound = qdf.Parameters.count - 1
    On Error GoTo 0
    Dim i As Long: For i = 0 To paramsUBound
        Dim vName As String: vName = getNakedName(UCase(qdf.Parameters(i).name))
        If lParamters.exists(vName) Then
            qdf.Parameters(i).value = lParamters(vName)
        Else
            Dim value As Variant: value = InputBox("Value for Param " & qdf.Parameters(i).name)
            qdf.Parameters(i).value = value
        End If
    Next i
    Set queryDefWithParams = qdf
    Exit Function

Err_Handler:
    logError Err, "queryDefWithParams"
End Function

'-------------------------------------------------------------------------------
' -- Private Properties
'-------------------------------------------------------------------------------

'/**
' * RegExp um den Bei ein SELECT mit INTO ... erweitern
' * @return RegExp
' */
Private Property Get rxSelect()
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/^\s*((?:PARAM[^;]+;)?\s*select[\s\S]*?)(into (?:\:?\w+|\[\:?.+?\]))?((?:\s\bfrom\b.*)?;?)\s*$/i")
    Set rxSelect = rx
End Property

'/**
' * RegExp um den Bei ein Create Table
' * @return RegExp
' */
Private Property Get rxCreateTable()
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/\s*(CREATE\s+(?:UNIQUE\s+)?(TABLE|INDEX)\s+(\[.+?\]|\S+)([\s\S]+))/i")
    Set rxCreateTable = rx
End Property

'/**
' * RegExp um den Tabellennamen in einem SQL zuersetzen
' * @return RegExp
' */
Private Property Get rxTblName()
'    Static rxPl As Object: If rxPl Is Nothing Then Set rxPl = cRx("/(:?)\b(\w+)\b/g")
    If pRxTblName Is Nothing Then
        'Extra nicht static, da der Tabellenname ein Teil davon ist
        Dim placeholders() As String: placeholders = Split(parseNamePatterns(C_PLACEHOLDERS), ",")
        Dim i As Integer: For i = 0 To UBound(placeholders)
            placeholders(i) = "\b" & StrReverse(placeholders(i)) & "\b\:?|\]?" & StrReverse(placeholders(i)) & "\:?\["
        Next i
        Set pRxTblName = cRx("/(?:" & Join(placeholders, "|") & ")(?!['""\.])/ig")
    End If
    Set rxTblName = pRxTblName
End Property

'/**
' * @return String      WindowsUser
' */
Private Property Get activeUser() As String
    activeUser = CreateObject("WScript.NetWork").UserName
End Property

'/**
' * @return TempTableDefEnum
' */
Private Property Let pSettingsEnum(iEnum As TempTableDefEnum)
    pSettings.forceDrop = andB(iEnum, ttdForceDrop)
    pSettings.scopeClass = andB(iEnum, ttdScopeClass)
    pSettings.scopeUser = andB(iEnum, ttdScopeUser)
    pTempName = Empty
End Property
Private Property Get pSettingsEnum() As TempTableDefEnum
    pSettingsEnum = _
        IIf(pSettings.forceDrop, ttdForceDrop, 0) + _
        IIf(pSettings.scopeClass, ttdScopeClass, 0) + _
        IIf(pSettings.scopeUser, ttdScopeUser, 0)
End Property

'/**
' * gibt den Nackten Namen zurück. Entfernt ggf die []
' * @param  String
' * @return String
' */
Private Function getNakedName(ByVal iName As String) As String
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/^\[?(.*?)\]?$/i")
    If Not rx.test(iName) Then
        getNakedName = iName
    Else
        getNakedName = rx.execute(iName)(0).subMatches(0)
    End If
End Function

'-------------------------------------------------------------------------------
' -- Class Events
'-------------------------------------------------------------------------------
'/**
' * Initialisieren
Private Sub Class_Initialize()
    Set pDb = CurrentDb
    pSettingsEnum = TempTableDefEnum.[_Singleton]
    name = C_SINGLETON_NAME
    pUser = activeUser
End Sub

'/**
' * Abräumen
' *
Private Sub Class_Terminate()
    'Falls der Scop auf die Class gesetzt ist, die Tabelle löschen
    If scopeClass And exists Then drop
End Sub


'-------------------------------------------------------------------------------
' -- Libraries
'-------------------------------------------------------------------------------

'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function

'/**
' * Macht einen Bit-Vergleich
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/andb
' *
' * @param  Long
' * @param  Long
' * @return Boolean
' */
Private Function andB(ByVal iHaystack As Long, ByVal iNeedle As Long) As Boolean
    andB = ((iHaystack And iNeedle) = iNeedle)
End Function

'/**
' * Es wird versucht, den Paramter in seine eigentlichen Typ zu wandeln. Gar mit Textausgaben oder parsen von SQL interessant
' * http://wiki.yaslaw.info/doku.php/vba/cast/cval
' *
' * @example    cVal("Null") -> Null, cVal("True") -> -1
' * @param  Variant
' * @return Variant
' */
Private Function cVal(ByVal iValue As Variant) As Variant
On Error Resume Next
    Set cVal = iValue: cVal = iValue: cVal = eval(iValue)
End Function