parameter pop up box problem

G

Guest

Hi,

I'm building a QBF form at the moment. The form seems to work using unbound
boxes and background coding to have strings go to the query.

I have two list boxes [dept] and [documenttype] that are the unbound on form
"QBF_form2". Dept queries values that are strings, while documenttype
queries a number. So this is where I'm thinking my problem is, but I'm not
sure.

If I enter a value in documenttype from the list box, then the strings pass
on to the query fine and I get my results. However, even though the codign
is practically the same to pass the values of both list boxes, the values
that I enter in [dept] do not seem to pass to the query, rather if I choose
for example the value "tbs" in the [dept] list box, and try to run the query,
I get a Enter Parameter Value for TBS box. In this box, if I reenter TBS,
and press ok I get my values. If I check the query after this, the
criterai for the field [dept] is showing as [tbs] rather then "TBS" as it
does for my other list box.

Here is my code.

Private Function IncludeDept() As String
On Error GoTo ProcError
'-- Create the dept Where portion of the SQL statement

Dim deptvar As Variant
Dim strTemp As String


'-- for each of the items in the ItemsSelected collection
For Each deptvar In Me!Dept.ItemsSelected()

strTemp = strTemp & "[fkDeptID]=" & Me!Dept.ItemData(deptvar) & " OR "
Next

If Len(strTemp) > 0 Then
IncludeDept = "(" & Left$(strTemp, Len(strTemp) - 4) & ")"
Else
IncludeDept = ""
End If

ExitProc:
Exit Function
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume ExitProc
End Function


Public Function RequerySubform()
On Error GoTo ProcError

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim intRecordCount As Integer
Dim strdeptSQL As String
Dim strdocidSQL As String
Dim strCompleteSQL As String
Dim strdaterecSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("QBF_query2")

'-- If AutoRequery is set to True, or the Requery button was pressed,
'-- then re-create the Where clause for the recordsource of the subform

'**********************************************************
' Important note: You cannot use F8 to step through the following line of
code in break mode. If
' you attempt to do this, you will get run-time error # 2474:

' "The expression you entered requires the control to be in the active
window."

' You can drag the yellow pointer past this line of code.

If Me!optAutoRequery Or Screen.ActiveControl.Name = "cmdRequery" Then

'**********************************************************

'-- Store all the criteria for the Where statement
'-- into variables.

strdeptSQL = IncludeDept()
strdocidSQL = IncludeDocID()
strCompleteSQL = IncludeComplete()
strdaterecSQL = IncludeReceivedDate()

'-- Store the initial Where statement with whatever is from
'-- the dept criteria.
strWhereSQL = "Where "

If Len(strdeptSQL) <> 0 Then
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strdeptSQL
End If

etc etc etc.


Any help here would be greatly appreciated.
 
G

GeoffG

Jean-Francois:

I have made some assumptions. I assume your subform is on the QBF form, in
which case you can alter its RecordSource directly without editing its
query. I am not sure how to proceed with your optAutoRequery statement. I
have used the "In" keyword in the SQL strings, which creates a shorter
string and avoids a problem I came across a few years back.

Here is some sample code that might give you a way forward.


Private Sub cmdRequery_Click()

On Error GoTo Error_cmdRequery
Call IncludeDept
Call IncludeDocID
Call RequerySubform

Exit_cmdRequery:

Exit Sub

Error_cmdRequery:

MsgBox Err.Description
Resume Exit_cmdRequery

End Sub

Private Function IncludeDept() As String

' Build the Dept Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no departments are selected.

On Error GoTo Error_IncludeDept

Dim intItemCount As Integer
Dim deptvar As Variant
Dim strRetVal As String

' See if any Departments are selected:
intItemCount = Me.lstDept.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDept

' Initialise string:
strRetVal = "(fkDeptID) In ("

' Build SQL string:
For Each deptvar In Me.lstDept.ItemsSelected()
strRetVal = strRetVal & Chr(34) _
& Me.lstDept.ItemData(deptvar) & Chr(34) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDept:

IncludeDept = strRetVal

Exit Function

Error_IncludeDept:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDept

End Function

Private Function IncludeDocID()

' Build the DocID Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no DocIDs are selected.

On Error GoTo Error_IncludeDocID

Dim intItemCount As Integer
Dim vntDocID As Variant
Dim strRetVal As String

' See if any DocIDs are selected:
intItemCount = Me.lstDocType.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDocID

' Initialise string:
strRetVal = "[fkDocID] In("

' Build SQL string:
For Each vntDocID In Me.lstDocType.ItemsSelected()
strRetVal = strRetVal & Me.lstDocType.ItemData(vntDocID) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDocID:

IncludeDocID = strRetVal

Exit Function

Error_IncludeDocID:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDocID

End Function

Public Sub RequerySubform()

' SQL of query "QBF_query2" without WHERE clause:
Const SUBFORMSQL As String = _
"SELECT tblDeptDocs.* FROM tblDeptDocs "

Dim strDeptSQL As String
Dim strDocIDSQL As String
Dim strCompleteSQL As String
Dim strDateRecSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String

On Error GoTo Error_RequerySubform

' Build SQL string:
strWhereSQL = "WHERE"

' Add Dept (if any selected):
strDeptSQL = IncludeDept()
If Len(strDeptSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDeptSQL & " AND "
End If

' Add DocID (if any selected):
strDocIDSQL = IncludeDocID()
If Len(strDocIDSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDocIDSQL & " AND "
End If

' It seems you need to add more here.

' Get out if we've not added anything to SQL:
If Len(strWhereSQL) = 5 Then GoTo ExitRequerySubform

' Remove final " AND ":
strWhereSQL = Left(strWhereSQL, Len(strWhereSQL) - 5)

' Build full SQL string:
strFullSQL = SUBFORMSQL & strWhereSQL

' Send to Immediate window:
Debug.Print strFullSQL

' Change the SQL of the SubForm:
Me.SubFormControl.Form.RecordSource = strFullSQL

ExitRequerySubform:

Exit Sub

Error_RequerySubform:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure RequerySubform..."
Resume ExitRequerySubform

End Sub


Regards
Geoff






Jean-Francois Gauthier said:
Hi,

I'm building a QBF form at the moment. The form seems to work using
unbound
boxes and background coding to have strings go to the query.

I have two list boxes [dept] and [documenttype] that are the unbound on
form
"QBF_form2". Dept queries values that are strings, while documenttype
queries a number. So this is where I'm thinking my problem is, but I'm
not
sure.

If I enter a value in documenttype from the list box, then the strings
pass
on to the query fine and I get my results. However, even though the
codign
is practically the same to pass the values of both list boxes, the values
that I enter in [dept] do not seem to pass to the query, rather if I
choose
for example the value "tbs" in the [dept] list box, and try to run the
query,
I get a Enter Parameter Value for TBS box. In this box, if I reenter TBS,
and press ok I get my values. If I check the query after this, the
criterai for the field [dept] is showing as [tbs] rather then "TBS" as it
does for my other list box.

Here is my code.

Private Function IncludeDept() As String
On Error GoTo ProcError
'-- Create the dept Where portion of the SQL statement

Dim deptvar As Variant
Dim strTemp As String


'-- for each of the items in the ItemsSelected collection
For Each deptvar In Me!Dept.ItemsSelected()

strTemp = strTemp & "[fkDeptID]=" & Me!Dept.ItemData(deptvar) & "
OR "
Next

If Len(strTemp) > 0 Then
IncludeDept = "(" & Left$(strTemp, Len(strTemp) - 4) & ")"
Else
IncludeDept = ""
End If

ExitProc:
Exit Function
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume ExitProc
End Function


Public Function RequerySubform()
On Error GoTo ProcError

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim intRecordCount As Integer
Dim strdeptSQL As String
Dim strdocidSQL As String
Dim strCompleteSQL As String
Dim strdaterecSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("QBF_query2")

'-- If AutoRequery is set to True, or the Requery button was pressed,
'-- then re-create the Where clause for the recordsource of the subform

'**********************************************************
' Important note: You cannot use F8 to step through the following line of
code in break mode. If
' you attempt to do this, you will get run-time error # 2474:

' "The expression you entered requires the control to be in the active
window."

' You can drag the yellow pointer past this line of code.

If Me!optAutoRequery Or Screen.ActiveControl.Name = "cmdRequery" Then

'**********************************************************

'-- Store all the criteria for the Where statement
'-- into variables.

strdeptSQL = IncludeDept()
strdocidSQL = IncludeDocID()
strCompleteSQL = IncludeComplete()
strdaterecSQL = IncludeReceivedDate()

'-- Store the initial Where statement with whatever is from
'-- the dept criteria.
strWhereSQL = "Where "

If Len(strdeptSQL) <> 0 Then
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strdeptSQL
End If

etc etc etc.


Any help here would be greatly appreciated.
Click to expand...
 
G

Guest

Hi Geoff,

Thanks fro your help with this. I'm still having issues however. I get
the following error.

Error 3075: Syntax error (missing operator) in query expression
'([fkDeptID]=TBS) AND And ([docid]=21)'.

I'll try and figure out the cuase, as I have been for the last couple of
hours, but await your response until such a time.

Thank you.

JF

GeoffG said:
Jean-Francois:

I have made some assumptions. I assume your subform is on the QBF form, in
which case you can alter its RecordSource directly without editing its
query. I am not sure how to proceed with your optAutoRequery statement. I
have used the "In" keyword in the SQL strings, which creates a shorter
string and avoids a problem I came across a few years back.

Here is some sample code that might give you a way forward.


Private Sub cmdRequery_Click()

On Error GoTo Error_cmdRequery
Call IncludeDept
Call IncludeDocID
Call RequerySubform

Exit_cmdRequery:

Exit Sub

Error_cmdRequery:

MsgBox Err.Description
Resume Exit_cmdRequery

End Sub

Private Function IncludeDept() As String

' Build the Dept Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no departments are selected.

On Error GoTo Error_IncludeDept

Dim intItemCount As Integer
Dim deptvar As Variant
Dim strRetVal As String

' See if any Departments are selected:
intItemCount = Me.lstDept.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDept

' Initialise string:
strRetVal = "(fkDeptID) In ("

' Build SQL string:
For Each deptvar In Me.lstDept.ItemsSelected()
strRetVal = strRetVal & Chr(34) _
& Me.lstDept.ItemData(deptvar) & Chr(34) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDept:

IncludeDept = strRetVal

Exit Function

Error_IncludeDept:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDept

End Function

Private Function IncludeDocID()

' Build the DocID Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no DocIDs are selected.

On Error GoTo Error_IncludeDocID

Dim intItemCount As Integer
Dim vntDocID As Variant
Dim strRetVal As String

' See if any DocIDs are selected:
intItemCount = Me.lstDocType.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDocID

' Initialise string:
strRetVal = "[fkDocID] In("

' Build SQL string:
For Each vntDocID In Me.lstDocType.ItemsSelected()
strRetVal = strRetVal & Me.lstDocType.ItemData(vntDocID) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDocID:

IncludeDocID = strRetVal

Exit Function

Error_IncludeDocID:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDocID

End Function

Public Sub RequerySubform()

' SQL of query "QBF_query2" without WHERE clause:
Const SUBFORMSQL As String = _
"SELECT tblDeptDocs.* FROM tblDeptDocs "

Dim strDeptSQL As String
Dim strDocIDSQL As String
Dim strCompleteSQL As String
Dim strDateRecSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String

On Error GoTo Error_RequerySubform

' Build SQL string:
strWhereSQL = "WHERE"

' Add Dept (if any selected):
strDeptSQL = IncludeDept()
If Len(strDeptSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDeptSQL & " AND "
End If

' Add DocID (if any selected):
strDocIDSQL = IncludeDocID()
If Len(strDocIDSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDocIDSQL & " AND "
End If

' It seems you need to add more here.

' Get out if we've not added anything to SQL:
If Len(strWhereSQL) = 5 Then GoTo ExitRequerySubform

' Remove final " AND ":
strWhereSQL = Left(strWhereSQL, Len(strWhereSQL) - 5)

' Build full SQL string:
strFullSQL = SUBFORMSQL & strWhereSQL

' Send to Immediate window:
Debug.Print strFullSQL

' Change the SQL of the SubForm:
Me.SubFormControl.Form.RecordSource = strFullSQL

ExitRequerySubform:

Exit Sub

Error_RequerySubform:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure RequerySubform..."
Resume ExitRequerySubform

End Sub


Regards
Geoff






Jean-Francois Gauthier said:
Hi,

I'm building a QBF form at the moment. The form seems to work using
unbound
boxes and background coding to have strings go to the query.

I have two list boxes [dept] and [documenttype] that are the unbound on
form
"QBF_form2". Dept queries values that are strings, while documenttype
queries a number. So this is where I'm thinking my problem is, but I'm
not
sure.

If I enter a value in documenttype from the list box, then the strings
pass
on to the query fine and I get my results. However, even though the
codign
is practically the same to pass the values of both list boxes, the values
that I enter in [dept] do not seem to pass to the query, rather if I
choose
for example the value "tbs" in the [dept] list box, and try to run the
query,
I get a Enter Parameter Value for TBS box. In this box, if I reenter TBS,
and press ok I get my values. If I check the query after this, the
criterai for the field [dept] is showing as [tbs] rather then "TBS" as it
does for my other list box.

Here is my code.

Private Function IncludeDept() As String
On Error GoTo ProcError
'-- Create the dept Where portion of the SQL statement

Dim deptvar As Variant
Dim strTemp As String


'-- for each of the items in the ItemsSelected collection
For Each deptvar In Me!Dept.ItemsSelected()

strTemp = strTemp & "[fkDeptID]=" & Me!Dept.ItemData(deptvar) & "
OR "
Next

If Len(strTemp) > 0 Then
IncludeDept = "(" & Left$(strTemp, Len(strTemp) - 4) & ")"
Else
IncludeDept = ""
End If

ExitProc:
Exit Function
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume ExitProc
End Function


Public Function RequerySubform()
On Error GoTo ProcError

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim intRecordCount As Integer
Dim strdeptSQL As String
Dim strdocidSQL As String
Dim strCompleteSQL As String
Dim strdaterecSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("QBF_query2")

'-- If AutoRequery is set to True, or the Requery button was pressed,
'-- then re-create the Where clause for the recordsource of the subform

'**********************************************************
' Important note: You cannot use F8 to step through the following line of
code in break mode. If
' you attempt to do this, you will get run-time error # 2474:

' "The expression you entered requires the control to be in the active
window."

' You can drag the yellow pointer past this line of code.

If Me!optAutoRequery Or Screen.ActiveControl.Name = "cmdRequery" Then

'**********************************************************

'-- Store all the criteria for the Where statement
'-- into variables.

strdeptSQL = IncludeDept()
strdocidSQL = IncludeDocID()
strCompleteSQL = IncludeComplete()
strdaterecSQL = IncludeReceivedDate()

'-- Store the initial Where statement with whatever is from
Click to expand...
Click to expand...
 
G

Guest

Hi Geoff,

Ok I got your code to work with one pop up message coming up, but the
results going to the subform, which is great. However, I was kind of hoping
of having the SQL statement go to a query QBF_query2 as in my old code. I
was then able to do an excel export of the results, or have them go to a
report, something I cannot do now as the results seem to go directly to the
subform rather then through a query.

Thank you.

Sincerely,

Jean-Francois

GeoffG said:
Jean-Francois:

I have made some assumptions. I assume your subform is on the QBF form, in
which case you can alter its RecordSource directly without editing its
query. I am not sure how to proceed with your optAutoRequery statement. I
have used the "In" keyword in the SQL strings, which creates a shorter
string and avoids a problem I came across a few years back.

Here is some sample code that might give you a way forward.


Private Sub cmdRequery_Click()

On Error GoTo Error_cmdRequery
Call IncludeDept
Call IncludeDocID
Call RequerySubform

Exit_cmdRequery:

Exit Sub

Error_cmdRequery:

MsgBox Err.Description
Resume Exit_cmdRequery

End Sub

Private Function IncludeDept() As String

' Build the Dept Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no departments are selected.

On Error GoTo Error_IncludeDept

Dim intItemCount As Integer
Dim deptvar As Variant
Dim strRetVal As String

' See if any Departments are selected:
intItemCount = Me.lstDept.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDept

' Initialise string:
strRetVal = "(fkDeptID) In ("

' Build SQL string:
For Each deptvar In Me.lstDept.ItemsSelected()
strRetVal = strRetVal & Chr(34) _
& Me.lstDept.ItemData(deptvar) & Chr(34) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDept:

IncludeDept = strRetVal

Exit Function

Error_IncludeDept:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDept

End Function

Private Function IncludeDocID()

' Build the DocID Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no DocIDs are selected.

On Error GoTo Error_IncludeDocID

Dim intItemCount As Integer
Dim vntDocID As Variant
Dim strRetVal As String

' See if any DocIDs are selected:
intItemCount = Me.lstDocType.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDocID

' Initialise string:
strRetVal = "[fkDocID] In("

' Build SQL string:
For Each vntDocID In Me.lstDocType.ItemsSelected()
strRetVal = strRetVal & Me.lstDocType.ItemData(vntDocID) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDocID:

IncludeDocID = strRetVal

Exit Function

Error_IncludeDocID:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDocID

End Function

Public Sub RequerySubform()

' SQL of query "QBF_query2" without WHERE clause:
Const SUBFORMSQL As String = _
"SELECT tblDeptDocs.* FROM tblDeptDocs "

Dim strDeptSQL As String
Dim strDocIDSQL As String
Dim strCompleteSQL As String
Dim strDateRecSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String

On Error GoTo Error_RequerySubform

' Build SQL string:
strWhereSQL = "WHERE"

' Add Dept (if any selected):
strDeptSQL = IncludeDept()
If Len(strDeptSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDeptSQL & " AND "
End If

' Add DocID (if any selected):
strDocIDSQL = IncludeDocID()
If Len(strDocIDSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDocIDSQL & " AND "
End If

' It seems you need to add more here.

' Get out if we've not added anything to SQL:
If Len(strWhereSQL) = 5 Then GoTo ExitRequerySubform

' Remove final " AND ":
strWhereSQL = Left(strWhereSQL, Len(strWhereSQL) - 5)

' Build full SQL string:
strFullSQL = SUBFORMSQL & strWhereSQL

' Send to Immediate window:
Debug.Print strFullSQL

' Change the SQL of the SubForm:
Me.SubFormControl.Form.RecordSource = strFullSQL

ExitRequerySubform:

Exit Sub

Error_RequerySubform:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure RequerySubform..."
Resume ExitRequerySubform

End Sub


Regards
Geoff






Jean-Francois Gauthier said:
Hi,

I'm building a QBF form at the moment. The form seems to work using
unbound
boxes and background coding to have strings go to the query.

I have two list boxes [dept] and [documenttype] that are the unbound on
form
"QBF_form2". Dept queries values that are strings, while documenttype
queries a number. So this is where I'm thinking my problem is, but I'm
not
sure.

If I enter a value in documenttype from the list box, then the strings
pass
on to the query fine and I get my results. However, even though the
codign
is practically the same to pass the values of both list boxes, the values
that I enter in [dept] do not seem to pass to the query, rather if I
choose
for example the value "tbs" in the [dept] list box, and try to run the
query,
I get a Enter Parameter Value for TBS box. In this box, if I reenter TBS,
and press ok I get my values. If I check the query after this, the
criterai for the field [dept] is showing as [tbs] rather then "TBS" as it
does for my other list box.

Here is my code.

Private Function IncludeDept() As String
On Error GoTo ProcError
'-- Create the dept Where portion of the SQL statement

Dim deptvar As Variant
Dim strTemp As String


'-- for each of the items in the ItemsSelected collection
For Each deptvar In Me!Dept.ItemsSelected()

strTemp = strTemp & "[fkDeptID]=" & Me!Dept.ItemData(deptvar) & "
OR "
Next

If Len(strTemp) > 0 Then
IncludeDept = "(" & Left$(strTemp, Len(strTemp) - 4) & ")"
Else
IncludeDept = ""
End If

ExitProc:
Exit Function
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume ExitProc
End Function


Public Function RequerySubform()
On Error GoTo ProcError

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim intRecordCount As Integer
Dim strdeptSQL As String
Dim strdocidSQL As String
Dim strCompleteSQL As String
Dim strdaterecSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("QBF_query2")

'-- If AutoRequery is set to True, or the Requery button was pressed,
'-- then re-create the Where clause for the recordsource of the subform

'**********************************************************
' Important note: You cannot use F8 to step through the following line of
code in break mode. If
' you attempt to do this, you will get run-time error # 2474:

' "The expression you entered requires the control to be in the active
window."

' You can drag the yellow pointer past this line of code.

If Me!optAutoRequery Or Screen.ActiveControl.Name = "cmdRequery" Then

'**********************************************************

'-- Store all the criteria for the Where statement
'-- into variables.

strdeptSQL = IncludeDept()
strdocidSQL = IncludeDocID()
strCompleteSQL = IncludeComplete()
strdaterecSQL = IncludeReceivedDate()

'-- Store the initial Where statement with whatever is from
Click to expand...
Click to expand...
 
G

GeoffG

Jean-Francois:

I posted the previous code without the benefit of my first coffee of the
day! No doubt you spotted the unnecessary calls to the IncludeDept() and
IncludeDocID() functions in the cmdRequery_Click() subroutine.

The answer to your question is - yes - you can update the query. It is a
very simple change. Below is a revision to the code. I have marked the new
bits - otherwise, the code is the same as before.

The interesting new feature is that you have to put the name of the query
(QBF_query2) into the RecordSource property of the SubForm each time you
change the WHERE clause, as this forces the SubForm to requery with the new
conditions. This may seem strange because, as you know, the query's name
hasn't changed. However, the alternative of calling the SubForm's Requery
method doesn't update the SubForm; but re-inserting the name (as if it were
a new name) does.

When you change the SQL string behind the query, it means that, whenever the
Main Form or SubForm opens, the SubForm will show only the records returned
by the query as it was last saved. This may be perfectly OK for your
purposes. If not, you could change the SQL string back to a default SQL
string when your program finishes (perhaps without a WHERE clause).

Regards
Geoff


Private Sub cmdRequery_Click()

On Error GoTo Error_cmdRequery

'***** OLD CODE REMOVED *****
'Call IncludeDept
'Call IncludeDocID
'***** END OF OLD CODE *****

Call RequerySubform

Exit_cmdRequery:

Exit Sub

Error_cmdRequery:

MsgBox Err.Description
Resume Exit_cmdRequery

End Sub

Private Function IncludeDept() As String

' Build the Dept Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no departments are selected.

On Error GoTo Error_IncludeDept

Dim intItemCount As Integer
Dim deptvar As Variant
Dim strRetVal As String

' See if any Departments are selected:
intItemCount = Me.lstDept.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDept

' Initialise string:
strRetVal = "(fkDeptID) In ("

' Build SQL string:
For Each deptvar In Me.lstDept.ItemsSelected()
strRetVal = strRetVal & Chr(34) _
& Me.lstDept.ItemData(deptvar) & Chr(34) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDept:

IncludeDept = strRetVal

Exit Function

Error_IncludeDept:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDept

End Function

Private Function IncludeDocID()

' Build the DocID Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no DocIDs are selected.

On Error GoTo Error_IncludeDocID

Dim intItemCount As Integer
Dim vntDocID As Variant
Dim strRetVal As String

' See if any DocIDs are selected:
intItemCount = Me.lstDocType.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDocID

' Initialise string:
strRetVal = "[fkDocID] In("

' Build SQL string:
For Each vntDocID In Me.lstDocType.ItemsSelected()
strRetVal = strRetVal & Me.lstDocType.ItemData(vntDocID) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDocID:

IncludeDocID = strRetVal

Exit Function

Error_IncludeDocID:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDocID

End Function

Public Sub RequerySubform()

' SQL of query "QBF_query2" without WHERE clause:
Const SUBFORMSQL As String = _
"SELECT tblDeptDocs.* FROM tblDeptDocs "

'***** START OF NEW DECLARATIONS *****

' Query name constant:
Const QUERYNAME As String = "QBF_query2"

' Declare object variables:
Dim objDB As DAO.Database
Dim objQDF As DAO.QueryDef

'***** END OF NEW DECLARATIONS *******

' Declare other variables:
Dim strDeptSQL As String
Dim strDocIDSQL As String
Dim strCompleteSQL As String
Dim strDateRecSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String

On Error GoTo Error_RequerySubform

' Build SQL string:
strWhereSQL = "WHERE"

' Add Dept (if any selected):
strDeptSQL = IncludeDept()
If Len(strDeptSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDeptSQL & " AND "
End If

' Add DocID (if any selected):
strDocIDSQL = IncludeDocID()
If Len(strDocIDSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDocIDSQL & " AND "
End If

' It seems you need to add more here.

' Get out if we've not added anything to SQL:
If Len(strWhereSQL) = 5 Then GoTo ExitRequerySubform

' Remove final " AND ":
strWhereSQL = Left(strWhereSQL, Len(strWhereSQL) - 5)

' Build full SQL string:
strFullSQL = SUBFORMSQL & strWhereSQL

' Send to Immediate window:
Debug.Print strFullSQL


'***** NEW CODE START *****

' Update the query:
Set objDB = CurrentDb()
Set objQDF = objDB.QueryDefs(QUERYNAME)
objQDF.SQL = strFullSQL

'***** END OF NEW CODE *****


'***** UPDATED CODE *****

' OLD VERSION:
' ' Change the SQL of the SubForm:
' Me.SubFormControl.Form.RecordSource = strFullSQL

' NEW VERSION:
' Put query name into SubForm's RecordSource property
' to force subform to requery with new WHERE clause:
Me.SubFormControl.Form.RecordSource = QUERYNAME

'***** END OF UPDATED CODE ******


ExitRequerySubform:

'***** NEW CODE START *****

' Destroy object variables:
Set objQDF = Nothing
Set objDB = Nothing

'***** END OF NEW CODE *****

Exit Sub

Error_RequerySubform:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure RequerySubform..."
Resume ExitRequerySubform

End Sub
 
G

GeoffG

Jean-Francois:
... with one pop up message coming up ...
Click to expand...

Is the pop up message something you want or don't want? In other words, is
this pop up message some sort of undesirable error message you still haven't
eliminated? Or is this message OK?
I was then able to do an excel export of the results,
or have them go to a report
Click to expand...

Did you want to export the query's data or open a report using code? If you
want to do either but don't know how to, post back.

Regards
Geoff
 
G

Guest

Hi Geoff,

I am getting error messages at this line of code

Me.SubFormControl.Form.RecordSource = QUERYNAME

Any idea why?

Thank you.

Sincerely,

Jean-Francois

GeoffG said:
Jean-Francois:

I posted the previous code without the benefit of my first coffee of the
day! No doubt you spotted the unnecessary calls to the IncludeDept() and
IncludeDocID() functions in the cmdRequery_Click() subroutine.

The answer to your question is - yes - you can update the query. It is a
very simple change. Below is a revision to the code. I have marked the new
bits - otherwise, the code is the same as before.

The interesting new feature is that you have to put the name of the query
(QBF_query2) into the RecordSource property of the SubForm each time you
change the WHERE clause, as this forces the SubForm to requery with the new
conditions. This may seem strange because, as you know, the query's name
hasn't changed. However, the alternative of calling the SubForm's Requery
method doesn't update the SubForm; but re-inserting the name (as if it were
a new name) does.

When you change the SQL string behind the query, it means that, whenever the
Main Form or SubForm opens, the SubForm will show only the records returned
by the query as it was last saved. This may be perfectly OK for your
purposes. If not, you could change the SQL string back to a default SQL
string when your program finishes (perhaps without a WHERE clause).

Regards
Geoff


Private Sub cmdRequery_Click()

On Error GoTo Error_cmdRequery

'***** OLD CODE REMOVED *****
'Call IncludeDept
'Call IncludeDocID
'***** END OF OLD CODE *****

Call RequerySubform

Exit_cmdRequery:

Exit Sub

Error_cmdRequery:

MsgBox Err.Description
Resume Exit_cmdRequery

End Sub

Private Function IncludeDept() As String

' Build the Dept Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no departments are selected.

On Error GoTo Error_IncludeDept

Dim intItemCount As Integer
Dim deptvar As Variant
Dim strRetVal As String

' See if any Departments are selected:
intItemCount = Me.lstDept.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDept

' Initialise string:
strRetVal = "(fkDeptID) In ("

' Build SQL string:
For Each deptvar In Me.lstDept.ItemsSelected()
strRetVal = strRetVal & Chr(34) _
& Me.lstDept.ItemData(deptvar) & Chr(34) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDept:

IncludeDept = strRetVal

Exit Function

Error_IncludeDept:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDept

End Function

Private Function IncludeDocID()

' Build the DocID Where portion of the SQL statement

' RETURNS:
'
' Zero-length string if no DocIDs are selected.

On Error GoTo Error_IncludeDocID

Dim intItemCount As Integer
Dim vntDocID As Variant
Dim strRetVal As String

' See if any DocIDs are selected:
intItemCount = Me.lstDocType.ItemsSelected.Count
If intItemCount = 0 Then GoTo Exit_IncludeDocID

' Initialise string:
strRetVal = "[fkDocID] In("

' Build SQL string:
For Each vntDocID In Me.lstDocType.ItemsSelected()
strRetVal = strRetVal & Me.lstDocType.ItemData(vntDocID) & ", "
Next

' Remove final ", ":
strRetVal = Left(strRetVal, Len(strRetVal) - 2)

' Add final ")":
strRetVal = strRetVal & ")"

' Send to Immediate window:
Debug.Print strRetVal

Exit_IncludeDocID:

IncludeDocID = strRetVal

Exit Function

Error_IncludeDocID:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Includedept..."
Resume Exit_IncludeDocID

End Function

Public Sub RequerySubform()

' SQL of query "QBF_query2" without WHERE clause:
Const SUBFORMSQL As String = _
"SELECT tblDeptDocs.* FROM tblDeptDocs "

'***** START OF NEW DECLARATIONS *****

' Query name constant:
Const QUERYNAME As String = "QBF_query2"

' Declare object variables:
Dim objDB As DAO.Database
Dim objQDF As DAO.QueryDef

'***** END OF NEW DECLARATIONS *******

' Declare other variables:
Dim strDeptSQL As String
Dim strDocIDSQL As String
Dim strCompleteSQL As String
Dim strDateRecSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String

On Error GoTo Error_RequerySubform

' Build SQL string:
strWhereSQL = "WHERE"

' Add Dept (if any selected):
strDeptSQL = IncludeDept()
If Len(strDeptSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDeptSQL & " AND "
End If

' Add DocID (if any selected):
strDocIDSQL = IncludeDocID()
If Len(strDocIDSQL) > 0 Then
strWhereSQL = strWhereSQL & " " & strDocIDSQL & " AND "
End If

' It seems you need to add more here.

' Get out if we've not added anything to SQL:
If Len(strWhereSQL) = 5 Then GoTo ExitRequerySubform

' Remove final " AND ":
strWhereSQL = Left(strWhereSQL, Len(strWhereSQL) - 5)

' Build full SQL string:
strFullSQL = SUBFORMSQL & strWhereSQL

' Send to Immediate window:
Debug.Print strFullSQL


'***** NEW CODE START *****

' Update the query:
Set objDB = CurrentDb()
Set objQDF = objDB.QueryDefs(QUERYNAME)
objQDF.SQL = strFullSQL

'***** END OF NEW CODE *****


'***** UPDATED CODE *****

' OLD VERSION:
' ' Change the SQL of the SubForm:
' Me.SubFormControl.Form.RecordSource = strFullSQL

' NEW VERSION:
' Put query name into SubForm's RecordSource property
' to force subform to requery with new WHERE clause:
Me.SubFormControl.Form.RecordSource = QUERYNAME

'***** END OF UPDATED CODE ******


ExitRequerySubform:

'***** NEW CODE START *****

' Destroy object variables:
Set objQDF = Nothing
Set objDB = Nothing

'***** END OF NEW CODE *****

Exit Sub

Error_RequerySubform:

MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure RequerySubform..."
Resume ExitRequerySubform

End Sub





Jean-Francois Gauthier said:
Hi Geoff,

Ok I got your code to work with one pop up message coming up, but the
results going to the subform, which is great. However, I was kind of
hoping
of having the SQL statement go to a query QBF_query2 as in my old code.
I
was then able to do an excel export of the results, or have them go to a
report, something I cannot do now as the results seem to go directly to
the
subform rather then through a query.

Thank you.

Sincerely,

Jean-Francois
Click to expand...
Click to expand...
 
G

GeoffG

Jean-Francois:
I am getting error messages at this line of code
Me.SubFormControl.Form.RecordSource = QUERYNAME
Any idea why?
Click to expand...

There are two things to check:

1. Did you include the following new code lines? The first code line
defines the constant QUERYNAME, which contains the name of your query,
"QBF_query2". If you didn't define the constant, the above code line
wouldn't work.

'***** START OF NEW DECLARATIONS *****

' Query name constant:
Const QUERYNAME As String = "QBF_query2"

' Declare object variables:
Dim objDB As DAO.Database
Dim objQDF As DAO.QueryDef

'***** END OF NEW DECLARATIONS *******

2. Is the subform control (on the main form) named "SubFormControl"? To
check, open the main form in design view, select the control containing the
subform, open its property sheet, and check its NAME property. (It's
important that you don't open the subform; you just want to select the
control that contains the subform.) The code line:

Me.SubFormControl.Form.RecordSource = QUERYNAME

assumes that the NAME of the subform control is "SubFormControl". (In the
above code line, note that "SubFormControl" appears after the first period).
If the NAME of your subform control is different, simply change
"SubFormControl" in the above code line to the name of your subform control.

Regards
Geoff
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Ken Snell's Export to multiple Spreadsheets 9
Can the below code be modified for select. Drive Letter, Dir. 2
Search Bar Using Array 1
Syntax error in query! 1
help in query! 4
remove duplicate email addresses on bulk email 1
MS Access to Excel Code Review 2
Passing Parameter From Form mismatched criteria 10

Top