User-defined class for SQL Select expressions

[FishVal]

Hereby I'm proposing a way of convinient work with properties containing SQL Select statements, particulary RowSource property of ComboBox and ListBox.

The usual way is the following.

Private Sub Combo1_AfterUpdate()
 
    Me.Combo2.RowSource = "SELECT ... FROM ... WHERE Table2.keyID=" & Me.Combo1 & ";"
    Combo2.Requery
 
End Sub
 

Till now it looks good, however it has the following disadvantages.
1) It is not suitable to place in the code long string containing SQL Select statement with numerous fields and joins if the only purpose is to change WHERE clause.
2) Each time the RowSource property is changed in Design view the code has to be modified too.

A human being is not obliged to work so hard but a computer has to.

The solution I'm proposing is to write User-defined class.

Class module "SQLSelect".

 
Option Compare Database
 
Dim varClauses(1 To 4) As Variant
Dim strClausesNames(1 To 5) As String
Dim strSQL As String
 
Public Property Get SelectString() As String
    SelectString = Me.SelectExpression & ";"
End Property
 
Public Property Let SelectString(ByVal strNewValue As String)
 
    Dim intCutPosition As Integer
    Dim intCutLength As Integer
    Dim strSubStr As String
 
    strSQL = strNewValue
 
    For i = 1 To 4
        intCutPosition = InStr(1, strSQL, strClausesNames(i), vbTextCompare)
        If intCutPosition <> 0 Then
            intCutPosition = intCutPosition + Len(strClausesNames(i))
            For j = i + 1 To 5
                intCutLength = InStr(1, strSQL, _
                    strClausesNames(j), vbTextCompare)
                If intCutLength <> 0 Then
                    intCutLength = intCutLength - intCutPosition
                    strSubStr = Mid(strSQL, intCutPosition, intCutLength)
                    varClauses(i) = Trim(strSubStr)
                    Exit For
                End If
            Next j
            'Debug.Print strClausesNames(i) & "   <" & varClauses(i) & ">"
        Else
            varClauses(i) = Null
        End If
    Next i
 
End Property
 
Public Property Get What() As Variant
    What = varClauses(1)
End Property
 
Public Property Let What(ByVal vNewValue As Variant)
    varClauses(1) = vNewValue
End Property
 
Public Property Get From() As Variant
    From = varClauses(2)
End Property
 
Public Property Let From(ByVal vNewValue As Variant)
    varClauses(2) = vNewValue
End Property
 
Public Property Get Where() As Variant
    Where = varClauses(3)
End Property
 
Public Property Let Where(ByVal vNewValue As Variant)
    varClauses(3) = vNewValue
End Property
 
Public Property Get OrderBy() As Variant
    OrderBy = varClauses(4)
End Property
 
Public Property Let OrderBy(ByVal vNewValue As Variant)
    varClauses(4) = vNewValue
End Property
 
Private Sub Class_Initialize()
    strClausesNames(1) = "SELECT"
    strClausesNames(2) = "FROM"
    strClausesNames(3) = "WHERE"
    strClausesNames(4) = "ORDER BY"
    strClausesNames(5) = ";"
End Sub
 
Public Property Get SelectExpression() As String
 
    Dim varClause As Variant
 
    SelectExpression = ""
 
    For i = 1 To 4
        If Not (IsNull(varClauses(i)) Or IsEmpty(varClauses(i))) Then
            varClause = strClausesNames(i) & " " & varClauses(i)
            SelectExpression = SelectExpression & varClause & " "
        End If
    Next i
 
    SelectExpression = RTrim(SelectExpression)
 
End Property
 
 

The class has the following properties:

.What - r/w, SELECT clause of SQL Select statement
.From - r/w, FROM clause of SQL Select statement
.Where - r/w, WHERE clause of SQL Select statement
.OrderBy - r/w, ORDER clause of SQL Select statement
.SelectString - r/w, SQL Select statement with trailing ";"
.SelectExpression - r, the same as .SelectString w/o trailing ";"

Now the above example looks like.

Form module.

 
Private Sub Combo1_AfterUpdate()
 
    Dim sqlRowSource As New SQLSelect
 
    With Me.Combo2
        sqlRowSource.SelectString = .RowSource
        sqlRowSource.Where = "Table2.keyID=" & Me.Combo1
        .RowSource = sqlRowSource.SelectString
        .Requery
    End With
 
    Set sqlRowSource = Nothing
 
End Sub
 
 

To my mind this simple solution makes programming more flexible and provides a more readable and intuitive code.

I hope this will be helpful.

Best regards to all.

Fish