改进一下某大师写得很好的一个实例，应用于ADO 不邦定窗体（ADO+SQL）。

鱼儿游游

把某大师写得很好的一个实例，改了一下，应用于ADO 不邦定窗体（ADO+SQL）。改进后，完全是ADO记录集操作。
原实例应用于ADO 不邦定窗体（ADO+SQL）要解决以下四个问题：
1、只能筛选一次；
2、值列表的数据源；
3、SQL的查询不支持 Like '*'  之类的语句；
4、获取SQL数据库字段的类型、字段的中文标题。

解决方法：1、Private Sub cmdFilterOn_Click  过程加上一行(红色部分): m_frmBoundForm.Filter = ""
                 2、Private Sub cboFieldName_AfterUpdate 过程中把注释部分用红色的代码代替。
                 3 、Private Function AddCondition 函数加上一行(红色部分): strOperators = Replace(strOperators, "*", "%")
                 4、Private Function SetDataFilter 过程中把注释部分用红色的代码代替。

在此，对该大师为我们提供了这么好的实例表示感谢！

Private Sub cmdFilterOn_Click()
    If Not IsNull(Me.txtWhereCondition) Then
       m_frmBoundForm.Filter = ""
        m_frmBoundForm.Filter = Trim$(Me.txtWhereCondition)
        m_frmBoundForm.FilterOn = True
    End If
.....
End sub

Private Function AddCondition()
.....
    Case "Like '*|*'", "Not Like '*|*'", "Like '|*'", "Not Like '|*'", "Like '*|'", "Not Like '*|'"
        '如果使用Like运算符，将其中的特殊字符进行转换
.....
        strMatch = Replace(strMatch, "#", "[#]")
        strOperators = Replace(strOperators, "*", "%")
        strWhere = strFieldName & Replace(strOperators, "|", strMatch)
    End Select
.....
End sub

Private Sub cboFieldName_AfterUpdate()
If Me.cboFieldName.Column(1) <> cuYesNo Then
        If Me.chkShowValueList Then
            '非“是否”类型字段时，将该字段所有的值(排除重复值和空值)在3个比较值输入框的下拉列表中显示
'            Me.cboMatchValue.RowSourceType = "Table/Query"
'            strSQL = Trim$(m_frmBoundForm.RecordSource)
'            If strSQL Like "*;" Then strSQL = "(" & Left$(strSQL, Len(strSQL) - 1) & ")"
'            strSQL = " SELECT CStr([" & Me.cboFieldName & "])" & _
'                     " FROM " & strSQL & _
'                     " GROUP BY [" & Me.cboFieldName & "]" & _
'                     " HAVING [" & Me.cboFieldName & "] Is Not Null" & _
'                     " ORDER BY [" & Me.cboFieldName & "]"
'                    Debug.Print strSQL
'            Me.cboMatchValue.RowSource = strSQL
      
            '设置值列表
            Dim varBookmark As Variant
            Dim strValue    As String
            Dim dic         As Object
            Set dic = CreateObject("Scripting.Dictionary")
            With Me.cboMatchValue
               .RowSource = ""
               .RowSourceType = "Value List"  
               .ColumnCount = 1         
               .ColumnWidths = .Width
               With m_frmBoundForm.Recordset
                  varBookmark = .Bookmark
                  .MoveFirst
                  Do While Not .EOF
                      strValue = CStr(Nz(.Fields(Me.cboFieldName.Value), ""))
                      If Not dic.Exists(strValue) Then
                         dic("" & strValue) = ""
                         Me.cboMatchValue.AddItem strValue
                      End If
                     .MoveNext
                  Loop
                  .Bookmark = varBookmark
               End With
            End With
            Set dic = Nothing
        Else
            Me.cboMatchValue.RowSource = ""
        End If
    End If
......
End sub

Private Function SetDataFilter() As Boolean
......
    On Error Resume Next
'    '添加字段列表（字段名,数据类型,字段标题），字段标题用于显示，如果没有则显示字段名
'    For Each fld In m_frmBoundForm.Recordset.Fields
'        strTemp = fld.Name
'        Select Case fld.Type
'        Case 1
'            strTemp = strTemp & ";" & cuYesNo
'        Case 2, 3, 4, 5, 6, 7, 15, 20
'            strTemp = strTemp & ";" & cuNumeric
'        Case 8
'            strTemp = strTemp & ";" & cuDate
'        Case 10, 12
'            strTemp = strTemp & ";" & cuText
'        Case Else
'            strTemp = ""
'        End Select
'        If strTemp <> "" Then
'            strCaption = ""
'            strCaption = fld.Properties("Caption").Value
'            If strCaption = "" Then strCaption = fld.Name
'            strTemp = strTemp & ";" & strCaption
'            Me.cboFieldName.AddItem strTemp
'        End If
'    Next
   For Each fld In m_frmBoundForm.Recordset.Fields
           strTemp = fld.Name         
           Select Case fld.Type
           Case 11
               strTemp = strTemp & ";" & cuYesNo
           Case 2, 3, 17, 20, 4, 5, 6, 131
               strTemp = strTemp & ";" & cuNumeric
           Case 135
               strTemp = strTemp & ";" & cuDate
           Case 129, 130, 200, 201, 202, 203
               strTemp = strTemp & ";" & cuText
           Case Else
               strTemp = ""
           End Select
           If strTemp <> "" Then
               strCaption = ""
               For Each ctl In m_frmBoundForm.Controls
                   If ctl.ControlType = acLabel Then         '标签控件
                      If ctl.Name = fld.Name & "_Label" Then
                         strCaption = ctl.Caption
                      End If
                   End If
               Next
               If strCaption = "" Then strCaption = fld.Name
               strTemp = strTemp & ";" & strCaption
               Me.cboFieldName.AddItem strTemp
           End If
       Next
......
  On Error GoTo Err_SetDataFilter
......
End sub

yanwei82123300

来个例子！最好！

tmtony

谢谢鱼儿 分享

鱼儿游游

tmtony  老师，给点分，鼓励一下吧?

tmtony

加了。

caoguangyao

先抄下再说，以备后用

鱼儿游游

多谢 tmtony  老师, 呵呵。

冰火火冰

记个号，，

xuwenning

谢谢分享
学习了

风啸啸

来一个例子！