Adding a Property to a query

[John Spencer]

I am trying to add a "RecordSetType" property to a query that I have created
using VBA.

If I build the query and set the property in the query grid, then I can
modify the property, however I don't seem to be able to create the property
and assign a value to it in my VBA. Query 9 exists at the point I am
running this test code. The property does not yet exist.

Public Sub TESTING()
Dim dbany As DAO.Database


Dim qdef As DAO.QueryDef
Dim prp As DAO.Property

Set dbany = CurrentDb()
Set qdef = dbany.QueryDefs("Query9")

Set prp = qdef.CreateProperty("RecordSetType", dbInteger, 2)
'???? --- what should I add here.

End Sub

 

[Marshall Barton]

I am trying to add a "RecordSetType" property to a query that I have created
using VBA.

If I build the query and set the property in the query grid, then I can
modify the property, however I don't seem to be able to create the property
and assign a value to it in my VBA. Query 9 exists at the point I am
running this test code. The property does not yet exist.

Public Sub TESTING()
Dim dbany As DAO.Database


Dim qdef As DAO.QueryDef
Dim prp As DAO.Property

Set dbany = CurrentDb()
Set qdef = dbany.QueryDefs("Query9")

Set prp = qdef.CreateProperty("RecordSetType", dbInteger, 2)
'???? --- what should I add here.

End Sub

qdef.Properties.Append prp

 

[John Spencer]

Yeah. I did try that but still getting no satisfaction.

If I just open the query in design view and change the value of the
property, then I have no further problems editing the value. I'm just
trying to make the query a snapshot so no one can edit data in it when it is
displayed as the source for a subform control that is bound to the query
(not to a form). When I bind the query to the sub form I get a datasheet
view of the query.



--
John Spencer
Access MVP 2002-2005, 2007-2008
Center for Health Program Development and Management
University of Maryland Baltimore County
..

 

[Marshall Barton]

Yeah. I did try that but still getting no satisfaction.

If I just open the query in design view and change the value of the
property, then I have no further problems editing the value. I'm just
trying to make the query a snapshot so no one can edit data in it when it is
displayed as the source for a subform control that is bound to the query
(not to a form). When I bind the query to the sub form I get a datasheet
view of the query.

I'm not sure what happens to the query's property when a
form is bound to the query. Does it work when you manually
set the property?

Does a qdef.Properties.Refresh or
CurrentDb.QueryDefs.Refresh make any difference?
How about when you close and reopen the db?

 

[John Spencer]

Marshall,
Here is the entire routine as I have it now. It is a little sloppy as I am
changing the routine and have been trying various things to make the query
property be added and updated. The new code starts at the lines of pluses.

Private Function fBuildSQL()
'*******************************************
'Name: sBuildSQL (Sub)
'Purpose: Build an SQL Statement
'Author: John Spencer UMBC-CHPDM
'Date: January 17, 2002, 03:36:51 PM
'*******************************************

On Error GoTo ErrHandler
Dim strSQL As String
Dim strFieldList As String
Dim strJoinType As String
Dim i As Integer, i2 As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsQdf As DAO.Recordset
Dim fld As Field
Dim strSearchCriteria As String, strSearchOperator As String
Dim strSQLTemp As String
Dim strFldName As String, iFldType As Integer
Dim strNEWSQL As String, strNEWWhere As String
Dim qdfAny As QueryDef
Dim strX As String
'-----------------------------------------------------------------------
' BUILD SELECT CLAUSE
'-----------------------------------------------------------------------
'Get SELECT statement including Distinct, DistinctRow, and TOP n
i = InStr(1, strSelect, " Distinct ", vbTextCompare)
If i = 7 Then strSQLTemp = " Distinct "

i = InStr(1, strSelect, " Distinctrow ", vbTextCompare)
If i = 7 Then strSQLTemp = " DistinctRow "

i = InStr(1, strSelect, " Top ", vbTextCompare)
If i >= 7 And i <= 20 Then
strSQLTemp = strSQLTemp & " TOP "
i2 = InStr(i + 5, strSelect, " ", vbTextCompare)
strSQLTemp = strSQLTemp & Mid(strSelect, i + 5, i2 - (i + 5))
End If

If Me.chkShowDistinct = True Then
strX = fCheckDistinctDenied()

If Len(strX) > 0 Then
MsgBox "Distinct Not Allowed with " & strX & "!", , "No Distinct
with Memo fields"
Me.chkShowDistinct = False
Else

If InStr(1, strSQLTemp, " Distinct ", vbTextCompare) = 0 Or _
InStr(1, strSQLTemp, " Distinct ", vbTextCompare) > 15 Then
strSQLTemp = " DISTINCT " & strSQLTemp
End If
End If 'fCheckDistinctDenied
End If 'Me.chkShowDistinct = True

strSQLTemp = "SELECT " & strSQLTemp

'-----------------------------------------------------------------------
' SPECIFIED FIELDS
'-----------------------------------------------------------------------
strFieldList = fBuildSQLFieldList()

strSQLTemp = strSQLTemp & strFieldList & vbCrLf

'---------------------------------------------------------------
'Build the NEW WHERE clause
'---------------------------------------------------------------
'Right now we have n combo/textbox sets so set up the
'master loop to go through these controls
' For i = 0 To conMAXCONTROLS - 1
For i = 0 To cCountCriteria - 1
If Len(Me("cbxFld" & i) & "") > 0 And Len(Me("Txtval" & i) & "") > 0 _
Or Me("cmbCondition" & i) = "<>Null" Or Me("cmbCondition" & i) =
"Null" Then

If i > 0 And Len(strNEWWhere) > 0 Then
Select Case Me("opgClauseType" & i)
Case 1
strJoinType = " OR "
Case 2
strJoinType = " AND "
Case Else
strJoinType = "" 'ERROR CONDITION
Beep
End Select
End If 'Set StrJoinType

'get field name from vArFields array
strFldName = fGetOtherFieldName(Me("cbxfld" & i))
iFldType = fGetFieldType(Me("cbxFld" & i))

strSearchOperator = Me("cmbCondition" & i) & ""

If Len(Trim(strSearchOperator & "")) = 0 Then strSearchOperator =
"="

strSearchCriteria = Me("txtVal" & i) & ""

Select Case strSearchOperator
Case "=", ""
strSearchCriteria = strSearchCriteria
strSearchOperator = "="

Case ">", "<", ">=", "<=", "<>"
strSearchCriteria = strSearchCriteria

Case "Null"
strSearchCriteria = ""
strSearchOperator = "Is Null"

Case "<>Null"
strSearchCriteria = ""
strSearchOperator = "Is not Null"

Case "x*"
strSearchCriteria = strSearchCriteria & "*"
strSearchOperator = "Like"

Case "<>x*"
strSearchCriteria = strSearchCriteria & "*"
strSearchOperator = "Not Like"

Case "*x*"
strSearchCriteria = "*" & strSearchCriteria & "*"
strSearchOperator = "Like"

Case "<>*x*"
strSearchCriteria = "*" & strSearchCriteria & "*"
strSearchOperator = "Not Like"

Case "In", "<>In"
'Check field type and set item list up with proper
separators for dates
Select Case iFldType
Case dbDate
strSearchCriteria = "#" & Trim(strSearchCriteria) &
"#"
strSearchCriteria = ReplaceString(strSearchCriteria,
",", "#, #")

Case dbText, dbMemo
strSearchCriteria = Chr$(34) &
Trim(strSearchCriteria) & Chr$(34)
strSearchCriteria = ReplaceString(strSearchCriteria,
",", _
Chr$(34) & ", " & Chr$(34))

End Select

strSearchCriteria = " (" & strSearchCriteria & ")"

If strSearchOperator = "<>In" Then
strSearchOperator = "Not In"
End If

Case "Between"
strSearchOperator = "Between"
If Len(Trim(strSearchCriteria)) = 0 Then

ElseIf Trim(strSearchCriteria) = "And" Then
strSearchCriteria = vbNullString

ElseIf InStr(1, strSearchCriteria, " and ", vbTextCompare)
= 0 Then
strSearchCriteria = strSearchCriteria & " AND " &
strSearchCriteria

End If
End Select

If (iFldType = 10 Or iFldType = 12) And Right(strSearchOperator,
2) <> "In" Then
If Len(strSearchCriteria) > 0 Then
If Left(strSearchCriteria, 1) <> Chr(34) Then
strSearchCriteria = Chr(34) & strSearchCriteria
End If

If Right(strSearchCriteria, 1) <> Chr(34) Then
strSearchCriteria = strSearchCriteria & Chr(34)
End If
End If
End If

strNEWWhere = strNEWWhere & strJoinType _
& Application.BuildCriteria("" & strFldName & "", _
iFldType, strSearchOperator & " " & strSearchCriteria &
"")

End If ' Fieldname and Text Value are there
Next i

If Len(strWhere) > 0 And Len(strNEWWhere) > 0 Then
strNEWWhere = strWhere & " AND " & strNEWWhere

ElseIf Len(strWhere) > 0 Then
strNEWWhere = strWhere

ElseIf Len(strNEWWhere) > 0 Then
strNEWWhere = " WHERE " & strNEWWhere
End If


'---------------------------SPECIFIED SORT
ORDER ------------------------------
Dim strNewOrderBy As String
'Parse the order by list and build the Order by
strNewOrderBy = fBuildSQLSort(Me.lstSortOrder.RowSource)


fBuildSQL = strParameters & _
strSQLTemp & _
strFrom & vbCrLf & _
strNEWWhere & vbCrLf & _
strGroupBy & _
strHaving & _
strNewOrderBy

Me.txtSQL = strParameters & _
strSQLTemp & _
strFrom & vbCrLf & _
strNEWWhere & vbCrLf & _
strGroupBy & _
strHaving & _
strNewOrderBy
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
If DoesQueryExist("Display_AdHoc_Results") = False Then
CurrentDb.CreateQueryDef "Display_AdHoc_Results"
CurrentDb().QueryDefs("Display_AdHoc_Results").SQL = Me.txtSQL
DoEvents
CurrentDb().QueryDefs.Refresh
CurrentDb().QueryDefs("Display_AdHoc_Results").Properties("RecordsetType")
= 2
CurrentDb().QueryDefs.Refresh
DoEvents

End If

CurrentDb().QueryDefs("Display_AdHoc_Results").SQL = Me.txtSQL

ExitHere:

Set rsQdf = Nothing
Set rs = Nothing
Set db = Nothing
Exit Function

ErrHandler:
Select Case Err.Number

Case 3270
Dim dbany As DAO.Database
Dim qdef As DAO.QueryDef
Dim prp As DAO.Property

Set dbany = CurrentDb()
Set qdef = dbany.QueryDefs("Display_AdHoc_Results")

Set prp = qdef.CreateProperty("RecordSetType", dbInteger, 2)
qdef.Properties.Append prp
qdef.Properties.Refresh
dbany.QueryDefs.Refresh

Resume
'we're trying to open a parameter query
Case 3061
MsgBox "The " & mconQ & Me.lstTables & mconQ & " query you've
selected " _
& " is a Parameter Query." & vbCrLf & Err.Description,
vbExclamation + vbOKOnly, _
"Missing parameters"

Case Else
MsgBox Err.Number & ": " & Err.Description, , "fBuildSQL"
Me.txtSQL = ""
Resume Next
'Either invalid SQL or some other error
End Select

Me.SfrmDisplayData.SourceObject = vbNullString

Resume ExitHere
End Function

--
John Spencer
Access MVP 2002-2005, 2007-2008
Center for Health Program Development and Management
University of Maryland Baltimore County
..

 

[Marshall Barton]

John, I don't see anything wrong with the code.

Does closing and reopening the database make a difference

Do you get the desired effect if you manually set the
property?

Not relevant to the question, but can't you use the
BuildCriteria function to simplify a lot of the where clause
code?

 

[John Spencer]

Marsh,

Closing and reopening has no effect on this problem.

If I set the property manually, then it works AND I can then set the
property programatically. It is not terribly important as I can always copy
the dummy query along with the form. The only reason it is important to me
is that I don't like to be defeated when I am trying to do something. I
know it should be possible, but for some reason Access 2003 SP1 won't
cooperate and let me add a property.

Build criteria function would probably work. When I originally put this
together I was unaware of the BuildCriteria function.

I may go take a look at that. I was rewriting this entire functionality
(it's akin to Duane's QBF database) to clean up a few things and add some
additional abilities.

Thanks for your time.
--
John Spencer
Access MVP 2002-2005, 2007-2008
Center for Health Program Development and Management
University of Maryland Baltimore County
..