Continued from Last Week's Topic.
With last week’s introduction, we have seen various ways to change the Top Value Property and other properties to change the SQL string of a SELECT Query. Now we will learn how to redefine the Query for the Top Values and other property changes.
As I mentioned earlier, three types of queries, SELECT, APPEND, and MAKE-TABLE, only have the Top Values property. SELECT and MAKE-TABLE queries have almost identical SQL strings, with DISTINCT, TOP nn, and PERCENT clauses appearing immediately after the SELECT clause at the beginning of the SQL String.
A sample SQL string of a MAKE-TABLE query is given below:
SELECT TOP 15 PERCENT SalesReportQ.* INTO chart FROM SalesReportQ ORDER BY SalesReportQ.Total DESC;
Unlike SELECT and MAKE-TABLE Queries, APPEND Queries have the Top Values property settings inserted somewhere in the middle of the SQL string immediately after the SELECT clause. Check the sample SQL of the Append Query given below:
INSERT INTO Table3 ( xID, Field1, Field2 ) SELECT DISTINCT TOP 17 PERCENT Table2.ID, Table2.Field1, Table2.Field2 FROM Table2 ORDER BY Table2.ID DESC;
Our VBA program scans through the SQL String to find the TOP Values property Clauses in the SQL String(wherever they appear), removes the existing settings, and inserts changes as per input from the User.
First, we will create a form for the User to input the Query 'Top Values' property values and click a CommandButton to redefine the SQL.
An image of a sample form is given below:
Two TextBoxes named Qry and TopVal, for Query name and Top values parameters, respectively, and a CheckBox named Unik for Unique value selection. The Top Values TextBox can be set to a number or a percentage (15%). If the Unik checkbox is set, then the query suppresses duplicate records based on the selected field values in the Query.
After setting the Query property values in the controls, the user should click the CommandButton to redefine the selected query SQL in the Query Name control. The CommandButton's name is cmdRun (the Caption: Modify Query). When the Command Button is clicked, the cmdRun_Click() Event Procedure is run (the VBA Code is given below) and validates the input values in the controls above and calls the QryTopVal() function (with parameters: query name, Top Values property value, and Checkbox value) to redefine the Query based on the user inputs.
Form Module Code.
Private Sub cmdRun_Click()
Dim strQuery, strTopVal, bool As Boolean
Dim msg As String
On Error GoTo cmdRun_Click_Err
msg = ""
strQuery = Nz(Me![Qry], "")
If Len(strQuery) = 0 Then
msg = " *>> Query Name not found." & vbCr
End If
strTopVal = Nz(Me![TopVal], 0)
If strTopVal = 0 Then
msg = msg & " *>> Top Property Value not given."
End If
bool = Nz(Me![Unik], 0)
If Len(msg) > 0 Then
msg = "Invalid Parameter Values:" & vbCr & vbCr & msg
msg = msg & vbCr & vbCr & "Query not changed, Program Aborted...."
MsgBox msg, , "cmdRun_Click()"
Else
'Call the QryTopVal() Function to redefine the Query
QryTopVal strQuery, strTopVal, bool
End If
cmdRun_Click_Exit:
Exit Sub
cmdRun_Click_Err:
MsgBox Err.Description, , "cmdRun_Click()"
Resume cmdRun_Click_Exit
End SubCopy and paste the VBA code into the Form Module and save the Form. Don't forget to name the Command Button as cmdRun.
The Main Function QryTopVal().
The main function QryTopVal() checks the validity of the Query Type (SELECT, APPEND, or MAKE-TABLE) and reads the Query SQL. Checks for the existence of Top Values and other Property settings; if they exist, then removes them. Redefines the query based on the Top Values and other property inputs.
Copy and paste the following VBA code for QryTopVal() into the Standard Module and save it:
Public Function QryTopVal(ByVal strQryName As String, _
ByVal TopValORPercent As String, _
Optional ByVal bulUnique As Boolean = False)
'--------------------------------------------------------------------
'Author : a.p.r. pillai
'Date : Jun 2011
'Remarks: All Rights Reserved by www.msaccesstips.com
'Valid Query Types:
' 0 - SELECT
' 64 - APPEND
' 80 - MAKE TABLE
'--------------------------------------------------------------------
Dim strSQL1 As String, strSQL2 As String, strTopValue
Dim db As Database, qrydef As QueryDef, sql As String
Dim loc, qryType As Integer, locTop
Dim txt(1 To 3) As String, num
Dim J, xt, msg As String
On Error GoTo QryTopVal_Err
txt(1) = "DISTINCT"
txt(2) = "TOP"
txt(3) = "PERCENT"
Set db = CurrentDb
Set qrydef = db.QueryDefs(strQryName)
qryType = qrydef.Type
If qryType = 0 Or qryType = 64 Or qryType = 80 Then
xt = qrydef.sql
GoSub ParseSQL
loc = InStr(1, TopValORPercent, "%")
If loc > 0 Then
TopValORPercent = Left(TopValORPercent, Len(TopValORPercent) - 1)
End If
If Val(TopValORPercent) = 0 Then
sql = strSQL1 & strSQL2
Else
sql = strSQL1 & IIf(bulUnique, "DISTINCT ", "") & "TOP " & TopValORPercent & IIf(loc > 0, " PERCENT ", "") & strSQL2
End If
qrydef.sql = sql
msg = "Query Definition of " & strQryName & vbCr & vbCr & "Changed successfully."
MsgBox msg, , "QryTop()"
Else
msg = strQryName & " - Invalid Query Type" & vbCr & vbCr
msg = msg & "Valid Query Types: SELECT, APPEND and MAKE-TABLE"
MsgBox msg, , "QryTop"
End If
QryTopVal_Exit:
Exit Function
ParseSQL:
For J = 1 To UBound(txt)
xt = Replace(xt, txt(J), "", 1)
Next
locTop = InStr(1, xt, "SELECT")
num = Val(Mid(xt, locTop + 7))
num = " " & Format(num) & " "
strSQL1 = Left(xt, locTop + 7)
xt = Right(xt, Len(xt) - (locTop + 7))
xt = Replace(xt, num, "", 1, 1)
strSQL2 = " " & xt
locTop = InStr(1, strSQL2, "ORDER BY")
If locTop = 0 Then
MsgBox "ORDER BY Clause not found in Query. Result may not be correct.", , "QryTopVal()"
End If
Return
QryTopVal_Err:
MsgBox Err & " : " & Err.Description, , "QryTopVal()"
Resume QryTopVal_Exit
End FunctionYou may try the Code with sample Queries.
