' Converts a form filter created in Acces into a format which is usable as WHERE clause
' for SQL Server
' Filters with other functions like "DatePart", "Year" and so on are not supported by ADO
' For more infos look here: http://msdn.microsoft.com/en-us/library/ms676691%28VS.85%29.aspx
Public Function fnSQLConvertFilter(frm As Form) As String
    Dim strFilter As Variant
    Dim strField As String
    Dim strValue1 As String
    Dim strValue2 As String
    Dim lngPos As Long
    Dim lngPos2 As Long
    
    strADOErr = "OK"
    
   On Error GoTo fnSQLConvertFilter_Error

    strFilter = frm.Filter
    
    If Nz(strFilter) = "" Then
        fnSQLConvertFilter = ""
        Exit Function
    End If
    
    strFilter = Replace(strFilter, "[" & frm.Name & "].", "")
    strFilter = Replace(strFilter, """", "'")
    strFilter = Replace(strFilter, "#", "'")
    strFilter = Replace(strFilter, "Date()", "GetDate()")
    strFilter = Replace(strFilter, "Now()", "GetDate()")
    strFilter = Replace(strFilter, "True", "1")
    strFilter = Replace(strFilter, "False", "0")
    strFilter = Replace(strFilter, "*", "%")
    strFilter = Replace(strFilter, "SELECT % ", "SELECT * ")
    strFilter = Replace(strFilter, " Alike ", " LIKE ")

    ' --------
    ' Replace a "BETWEEN"-Filter with ">=" and "<="
    lngPos = InStr(strFilter, "BETWEEN")
    If lngPos > 0 Then
        strField = Trim(Mid(strFilter, InStrRev(strFilter, "[", lngPos), InStrRev(strFilter, "]", lngPos) - InStrRev(strFilter, "[", lngPos) + 1))
        strFilter = Left(strFilter, lngPos - 1) & Replace(strFilter, "BETWEEN", " >= ", lngPos, 1)
        strFilter = Left(strFilter, lngPos - 1) & Replace(strFilter, " AND ", " AND " & strField & " <= ", lngPos, 1)
    End If
    
    strFilter = Replace(strFilter, "%53", "")
    
    ' --------
    ' ADO recordsets sends an error if "LIKE '%xxx'" is used.
    ' This exchanges the "LIKE '%xxx'" to "LIKE '%xxx%'" (second "%" at the end)
    ' to avoid the error.
    lngPos = 1
    Do
        lngPos = InStr(lngPos, strFilter, "LIKE '%")
        If lngPos > 0 Then
            lngPos2 = InStr(lngPos + 6, strFilter, "'")
            If Mid(strFilter, lngPos2 - 1, 1) <> "%" Then
                strFilter = Left(strFilter, lngPos2 - 1) & "%" & Right(strFilter, Len(strFilter) - lngPos2 + 1)
            End If
            lngPos = lngPos2
        End If
    Loop Until lngPos = 0
    
    fnSQLConvertFilter = strFilter

fnSQLConvertFilter_Exit:
    Exit Function

fnSQLConvertFilter_Error:
    strADOErr = "ERROR"
    Select Case Err
        Case Else
            fnErr "modODBC->fnSQLConvertFilter", True
            Resume fnSQLConvertFilter_Exit
    End Select
End Function

' fnADOSelectFilteredForm
' Date: 28.08.2009
'
' Returns the same records which are displayed in a form in an Access ADP
' filtered by any sort of user defined filter
'
' The RecordSource of the form should have the following structure:
' "SELECT Whatever FROM MyTable WHERE FormCondition ORDER BY FormOrder"
'
' GROUP and HAVING clauses are not supported.
'
Public Function fnADOSelectFilteredForm(frm As Form, Optional strAddWhere As String = "", _
                                        Optional intLockType As ADODB.LockTypeEnum = adLockReadOnly, _
                                        Optional intOpenMode As ADODB.CursorTypeEnum = adOpenStatic, _
                                        Optional intReturnAs As enmADOReturnAs = enmADOReturnAsRecordset) As ADODB.Recordset
    
    Dim rsADO As ADODB.Recordset
    Dim strSQL As String
    Dim strOrderBy As String
    Dim strWhere As String
    Dim strFilter As String
    Dim strServerFilter As String
    Dim strWhereWord As String
    Dim strSchema As String
    Dim strIDs As String
    
   On Error GoTo fnADOSelectFilteredForm_Error

    Set rsADO = frm.Recordset.Clone
    strSQL = rsADO.Source
    
    ' stored procedure was used, no SQL string possible
    If Left(UCase(strSQL), 4) = "EXEC" Then
        ' get the user defined filter of the form and convert it to SQL server syntax
        strFilter = fnSQLConvertFilter(frm)
        If strAddWhere <> "" Then strFilter = strFilter & " AND (" & strAddWhere & ") "
        If frm.ServerFilter <> "" Then strFilter = strFilter & " AND (" & frm.ServerFilter & ") "
        ' set the same filter as used in the form to the copy of the recordset
        rsADO.Filter = strFilter
        Set fnADOSelectFilteredForm = rsADO
        GoTo fnADOSelectFilteredForm_Exit    ' ------------>
    End If
    
    ' Neither SELECT nor EXE then a direct table was entered as RecordSource of the form
    If Left(UCase(strSQL), 6) <> "SELECT" And Left(UCase(strSQL), 4) <> "EXEC" Then
        If frm.RecordSourceQualifier = Left(strSQL, Len(frm.RecordSourceQualifier)) Then
            strSchema = "[" & frm.RecordSourceQualifier & "]."
            strSQL = Right(strSQL, Len(strSQL) - Len(frm.RecordSourceQualifier) - 1)
        End If
        strSQL = "SELECT * FROM " & strSchema & strSQL
        If frm.OrderByOnLoad = True And Nz(frm.OrderBy) <> "" Then
            strSQL = strSQL & " ORDER BY " & frm.OrderBy
        End If
    End If
    
    If InStrRev(UCase(strSQL), "ORDER BY") > 0 Then
        strOrderBy = Trim(Right(strSQL, Len(strSQL) - InStrRev(UCase(strSQL), "ORDER BY") + 1))
        strSQL = Trim(Left(strSQL, Len(strSQL) - Len(strOrderBy)))
    Else
        strOrderBy = ""
    End If
    
    If InStrRev(UCase(strSQL), "WHERE") > 0 Then
        strWhere = Trim(Right(strSQL, Len(strSQL) - InStrRev(UCase(strSQL), "WHERE") + 1))
        strSQL = Trim(Left(strSQL, Len(strSQL) - Len(strWhere)))
        strWhere = " (" & Trim(Right(strWhere, Len(strWhere) - 5)) & ") "
    Else
        strWhere = ""
    End If
    
    If frm.ServerFilter <> "" Then
        strServerFilter = " (" & frm.ServerFilter & ") "
    End If
    
    strFilter = fnSQLConvertFilter(frm)
    If strFilter <> "" Then
        If frm.FilterOn = True Then
            strFilter = " (" & strFilter & ") "
        Else
            strFilter = ""
        End If
    End If
    
    If strWhere <> "" Or strAddWhere <> "" Or strServerFilter <> "" Or strFilter <> "" Then
        strWhereWord = " WHERE "
    Else
        strWhereWord = " "
    End If
    
    If strAddWhere <> "" Then strAddWhere = " (" & strAddWhere & ") "
    
    strWhere = IIf(strWhere <> "", strWhere, "") & _
               IIf(strFilter <> "", " AND " & strFilter, "") & _
               IIf(strServerFilter <> "", " AND " & strServerFilter, "") & _
               IIf(strAddWhere <> "", " AND " & strAddWhere, "")
    
    If Left(strWhere, 5) = " AND " Then strWhere = Right(strWhere, Len(strWhere) - 5)
    
    strSQL = strSQL & strWhereWord & " " & strWhere & " " & IIf(strOrderBy <> "", strOrderBy, "")
    Select Case intReturnAs
        Case enmADOReturnAsRecordset
            Set fnADOSelectFilteredForm = fnADOSelectCommon(strSQL, intLockType, intOpenMode)
        Case enmADOReturnAsSQLString
            Set fnADOSelectFilteredForm = Nothing
    End Select
    strADOSQLString = strSQL

fnADOSelectFilteredForm_Exit:
    Exit Function

fnADOSelectFilteredForm_Error:
    Select Case Err
        Case Else
            fnErr "modODBC->fnADOSelectFilteredForm", True
    End Select
    If Not rsADO Is Nothing Then
        If rsADO.State = adStateOpen Then rsADO.Close
        Set rsADO = Nothing
    End If
    fnCloseODBCConnection
    Resume fnADOSelectFilteredForm_Exit
End Function