ADO recordset filter doesn't seem to stick!

[Jon von der Heyden]

Hi

I have a recordset from a select * query to an access DB table. I want to be able to filter the recordset (using filter property). The users enter the filter expression in a textbox. After that they have a choice to take the data into a pivot table, or a csv file. The code runs without a hitch (provided valid expression is entered), but when I check the outputs it still returns the unfiltered recordset.

Thoughts?

Private Sub cbtRun_Click()
    Dim objRecordset As ADODB.RecordSet
    Dim wkb As Workbook, wks As Worksheet
    Dim pvc As PivotCache
    Dim lngFile As Long, strFile As String
    Dim vararrData As Variant, lngRow As Long, lngCol As Long
    
    Set m_clsDB = New clsManageDB
    With m_clsDB
        .DBpath = Evaluate(ThisWorkbook.Names("str_const_DBPATH").RefersTo)
        Set objRecordset = .RunScript(Me.SQL)
    End With
    
    If CBool(Len(Me.tbxExpression.Text)) Then
        'MsgBox Me.tbxExpression.Text
        objRecordset.Filter = Me.tbxExpression.Text
    End If
    
    With Me
        If .Output = pvt Then
            Set wkb = Workbooks.Add
            '// delete all but 1 sheet
            Set wks = wkb.Sheets(1)
            Set pvc = wkb.PivotCaches.Add(xlExternal)
            Set pvc.RecordSet = objRecordset
            pvc.CreatePivotTable TableDestination:=wks.Range("A1")
        ElseIf .Output = CSV Then
            If Not CBool(Right(UCase$(.tbxFileName.Text), 3) = "CSV") Then
                MsgBox "No csv file, file name required!", vbExclamation
            Else
                'consider .txt with pipe delim
                lngFile = FreeFile
                strFile = .tbxFileName.Text
                Open strFile For Output As #lngFile
                    vararrData = Application.Transpose(objRecordset.GetRows)
                    For lngRow = LBound(vararrData, 1) To UBound(vararrData, 1)
                        For lngCol = LBound(vararrData, 2) To UBound(vararrData, 2)
                            Print #lngFile, "'" & vararrData(lngRow, lngCol) & "',";
                        Next lngCol
                        Print #lngFile,
                    Next lngRow
                Close #lngFile
            End If
        End If
    End With
    Set m_clsDB = Nothing
    Unload Me
End Sub

 

[Andrew Poulsom]

It seems you need to copy the filtered recordset to a ADO Stream and use that:

http://visualbasic.ittoolbox.com/groups/technical-functional/visualbasic-l/copy-recordset-47043

 

[Jon von der Heyden]

Nice one Andrew...

 

[Jon von der Heyden]

Thanks again Andrew.

I've decided to post back the snippet of code I've gone with because I don't think this problem has much coverage on the web and haven't seen it covered on our forum before.

So one again the problem is that 'exporting' a filtered recordset discards the filter and exports everything.

Preserving the recordset Filter:

    If CBool(Len(strFilterText)) Then
        objRecordset.Filter = strFilterText
        Set objStream = New ADODB.Stream
        With objRecordset
            .Save objStream, adPersistXML
            .Close
            .Open objStream
        End With
    End If

Exporting the recordset to pivot cache:

    Set wkb = Workbooks.Add
    Set wks = wkb.Sheets(1)
    Set pvc = wkb.PivotCaches.Add(xlExternal)
    Set pvc.RecordSet = objRecordset
    pvc.CreatePivotTable TableDestination:=wks.Range("A1")

Works a treat!

Further reading:
Recordset Object (ADO)
Stream Object (ADO)

Hope this helps someone.... somewhere... one day...