Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

Change Query Top Values Property with VBA-2

Through last week’s introduction we have seen various ways the Top Value and other properties 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 have mentioned earlier three type of Queries; SELECT, APPEND and MAKE-TABLE only have the Top Values property.  SELECT and MAKE-TABLE queries have almost identical SQL string with DISTINCT, TOP nn, 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 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 insert changes as per input from the User.

First we will create a form for the User to input Query Top Values property values and click a Command Button to redefine the SQL.

Image of a sample form is given below:

Two text boxes with the name Qry and TopVal, for Query name and for Top values parameters respectively and a checkbox with the name Unik for Unique value selection.  The Top Values text box can be set with a number or a number with a percentage symbol (like 20 or 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 above controls the user should click the Command Button to redefine the SQl of the selected query in the Query Name control.  The Command Button's name is cmdRun (with 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.

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 Sub

Copy and paste the above VBA Code into the Form Module and save the Form. Don't forget to name the Command Button as cmdRun.

The main function QryTopVal() checks the Query Type (SELECT or APPEND or MAKE-TABLE) and if found valid then reads the SQL of the query.  Checks for the existence of Top Values and other Property settings and if they exists then removes them.  Redefines the query based on the Top Values and other property inputs from the user.

Copy and paste the following VBA Code of 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 Function

You may try the Code with sample Queries.

Share:

No comments:

Post a Comment

Translate



PageRank
Your email address:

Delivered by FeedBurner

Search

Infolinks Text Ads


Blogs Directory

Popular Posts

Search This Blog

Blog Archive

Powered by Blogger.

Labels

Forms How Tos Functions MS-Access Security Reports msaccess forms Animations msaccess animation Utilities msaccess controls Access and Internet MS-Access Scurity MS-Access and Internet Queries External Links msaccess reports msaccess tips Menus and Toolbars Accesstips MsaccessLinks Process Controls Art Work Downloads msaccess How Tos Graph Charts msaccessQuery List Boxes Command Buttons Emails and Alerts Query Combo Boxes Custom Wizards DOS Commands ms-access functions msaccess graphs msaccess reporttricks msaccess functions msaccessprocess security advanced Access Security Data Macros Menus Property Report Top Values VBA msaccess email msaccess menus progressmeter Access2007 Array Auto-Number Command Button Copy Custom Functions Form Join Microsoft Numbering System Records Security Split SubForm Table Utility Workgroup database msaccess wizards Access2003 Accounting Year Action Animation Attachment Binary Numbers Bookmarks Budgeting Calculation ChDir Color Palette Conditional Formatting Controls Data Filtering Data Type Defining Pages Diagram Disk Dynamic Lookup Error Handler Excel Export Expression External Field Type Fields Filter Form Instances Formatting Groups Hexadecimal Numbers Import Labels List Logo Macro Mail Merge Main Form Memo Methods Monitoring Object Reference Objects Octal Numbers Operating System Paste Primary-Key Product Rank Reading Recordset Rich Text Sequence SetFocus Summary Tab-Page Tables Time Difference Union Query User Users Variables Water-Mark Word automatically commands function hyperlinks iSeries Date iif ms-access msaccess msaccess alerts pdf files reference restore switch text toolbar tutorial updating upload vba code

Featured Post

DIRectory and File Copy Utility

Last week we have seen how to use Dir() DOS Command , it’s ability to read files from the Disk  one by one and display it on the Debug Windo...

Labels

Blog Archive

Recent Posts