G
George Hester
With the help of Ken Snell (MVP) and others in this newsgroup and various
Microsoft Knowledge Base aritcles and a very good new forum on VBScript I
put together a Query in a DAP without the popup. This solution depends on
the fact that the ServerFilter object refreshes a DAP page by default when
called.
I have a command button on the page called Command3 and above the ending
<HEAD> tag put this in:
<SCRIPT language=vbscript event=onclick for=Command3>
<!--
MyFilter
-->
</SCRIPT>
Remember you must have the following script at the beginning of all your
<SCRIPT> tags in the <HEAD> tags to initialize all your data bound controls.
<SCRIPT language=vbscript event=Current(x) for=MSODSC>
<!--
'initialize data bound controls
-->
</SCRIPT>
The following are the functions for the query which come at the bottom of
the web page just above the ending <BODY> tag:. The table tblTest4 is a
table of 2 text fields comprising Author's names and titles of their works
and a Primary Key field which is Autonumbered. The fields are CAPTION_NAME,
CAPTION_TITLE and the first field has Primary Key and is an AutoNumber
field.
<SCRIPT language=vbscript>
<!--
Function SetServerFilter(strFilter)
Dim myFilter, rs
On Error Resume Next
If strFilter = "" Then
myFilter = strFilter
Else
Do Until InStr(strFilter, ";") = 0
myFilter = myFilter & "[Caption_Name] = " & Chr(39) & Left(strFilter, _
InStr(strFilter, ";") - 1) & Chr(39) & " OR "
strFilter = Right(strFilter, Len(strFilter) - InStr(strFilter, ";"))
Loop
myFilter = myFilter & "[Caption_Name] = " & Chr(39) & strFilter & Chr(39)
End If
MSODSC.RecordsetDefs.Item(0).ServerFilter = myFilter
Set rs = MSODSC.DefaultRecordset
If rs.RecordCount = 0 Then
Err.Raise 3021
MsgBox "An unexpected error has occured. The following:" & vbCrLf & _
" Error Number: " & Err.Number & vbCrLf & _
" Error.Description: Either BOF or EOF is True, or the current record
has" & vbCrLf & _
" been deleted; the operation requested by the application requires a" &
vbCrLf & _
" current record.",vbCritical,"Error"
Err.Clear
End If
Set rs = Nothing
End Function
Function MyFilter()
Dim sSQL, rs, i, tmpFilter, qtAuthor, qryAuthor
On Error Resume Next
i = 1
qtAuthor = "What Author's Name do you want to search for?"
qryAuthor = InputBox(qtAuthor,"Author search...")
tmpFilter = ""
sSql = "SELECT tblTest4.Caption_Title, tblTest4.Caption_Name" & vbCrLf & _
"FROM tblTest4" & vbCrLf & _
"WHERE tblTest4.Caption_Name Like '%" & qryAuthor & "%';"
Set rs = CreateObject("ADODB.RecordSet")
rs.Open sSQL, MSODSC.Connection
rs.MoveFirst
Do While i < rs.RecordCount + 1
tmpFilter = tmpFilter & rs.Fields("Caption_Name") & ";"
i = i + 1
rs.MoveNext
Loop
If Right(tmpFilter, 1) = ";" Then tmpFilter = Left(tmpFilter,
Len(tmpFilter) - 1)
tmpFilter = removeDups(tmpFilter)
SetServerFilter(tmpFilter)
rs.Close
Set rs = Nothing
End Function
Function removeDups(sList)
Dim sNewList, aList, maxItems, x
On Error Resume Next
Const vbTextCompare = 1
aList = Split(sList, ";", -1, vbTextCompare)
maxItems = UBound(aList)
For x = 0 To maxItems
If InStr(sNewList, (aList(x) & ";")) <= 0 Then sNewList = sNewList &
aList(x) & ";"
Next
removeDups = Left(sNewList, Len(sNewList) - 1)
End Function
-->
</SCRIPT>
That's it. It really all depends on the ServerFilter object in the
SetServerFilter function. Hopefully this is useful some time.
Microsoft Knowledge Base aritcles and a very good new forum on VBScript I
put together a Query in a DAP without the popup. This solution depends on
the fact that the ServerFilter object refreshes a DAP page by default when
called.
I have a command button on the page called Command3 and above the ending
<HEAD> tag put this in:
<SCRIPT language=vbscript event=onclick for=Command3>
<!--
MyFilter
-->
</SCRIPT>
Remember you must have the following script at the beginning of all your
<SCRIPT> tags in the <HEAD> tags to initialize all your data bound controls.
<SCRIPT language=vbscript event=Current(x) for=MSODSC>
<!--
'initialize data bound controls
-->
</SCRIPT>
The following are the functions for the query which come at the bottom of
the web page just above the ending <BODY> tag:. The table tblTest4 is a
table of 2 text fields comprising Author's names and titles of their works
and a Primary Key field which is Autonumbered. The fields are CAPTION_NAME,
CAPTION_TITLE and the first field has Primary Key and is an AutoNumber
field.
<SCRIPT language=vbscript>
<!--
Function SetServerFilter(strFilter)
Dim myFilter, rs
On Error Resume Next
If strFilter = "" Then
myFilter = strFilter
Else
Do Until InStr(strFilter, ";") = 0
myFilter = myFilter & "[Caption_Name] = " & Chr(39) & Left(strFilter, _
InStr(strFilter, ";") - 1) & Chr(39) & " OR "
strFilter = Right(strFilter, Len(strFilter) - InStr(strFilter, ";"))
Loop
myFilter = myFilter & "[Caption_Name] = " & Chr(39) & strFilter & Chr(39)
End If
MSODSC.RecordsetDefs.Item(0).ServerFilter = myFilter
Set rs = MSODSC.DefaultRecordset
If rs.RecordCount = 0 Then
Err.Raise 3021
MsgBox "An unexpected error has occured. The following:" & vbCrLf & _
" Error Number: " & Err.Number & vbCrLf & _
" Error.Description: Either BOF or EOF is True, or the current record
has" & vbCrLf & _
" been deleted; the operation requested by the application requires a" &
vbCrLf & _
" current record.",vbCritical,"Error"
Err.Clear
End If
Set rs = Nothing
End Function
Function MyFilter()
Dim sSQL, rs, i, tmpFilter, qtAuthor, qryAuthor
On Error Resume Next
i = 1
qtAuthor = "What Author's Name do you want to search for?"
qryAuthor = InputBox(qtAuthor,"Author search...")
tmpFilter = ""
sSql = "SELECT tblTest4.Caption_Title, tblTest4.Caption_Name" & vbCrLf & _
"FROM tblTest4" & vbCrLf & _
"WHERE tblTest4.Caption_Name Like '%" & qryAuthor & "%';"
Set rs = CreateObject("ADODB.RecordSet")
rs.Open sSQL, MSODSC.Connection
rs.MoveFirst
Do While i < rs.RecordCount + 1
tmpFilter = tmpFilter & rs.Fields("Caption_Name") & ";"
i = i + 1
rs.MoveNext
Loop
If Right(tmpFilter, 1) = ";" Then tmpFilter = Left(tmpFilter,
Len(tmpFilter) - 1)
tmpFilter = removeDups(tmpFilter)
SetServerFilter(tmpFilter)
rs.Close
Set rs = Nothing
End Function
Function removeDups(sList)
Dim sNewList, aList, maxItems, x
On Error Resume Next
Const vbTextCompare = 1
aList = Split(sList, ";", -1, vbTextCompare)
maxItems = UBound(aList)
For x = 0 To maxItems
If InStr(sNewList, (aList(x) & ";")) <= 0 Then sNewList = sNewList &
aList(x) & ";"
Next
removeDups = Left(sNewList, Len(sNewList) - 1)
End Function
-->
</SCRIPT>
That's it. It really all depends on the ServerFilter object in the
SetServerFilter function. Hopefully this is useful some time.