如何使用vba从Recordset设置Filter to Data [英] How to set Filter to Data From a Recordset with vba

问题描述

Hello 

我发现这个代码在线并且它可以工作并将记录添加到模板中。但是，它不是基于我的主窗体的过滤器记录。  我已经做了很多阅读，但不知道如何将记录集更改为过滤器
到子表单查询。任何帮助将不胜感激。 

功能Print3Year（）

Function Print3Year()

Dim lngColumn As long

Dim xlx As Object，xlw As Object，xls As Object，xlc As Object

Dim dbs作为DAO.Database

Dim rst作为DAO.Recordset

Dim blnEXCEL As Boolean，blnHeaderRow As Boolean



blnEXCEL = False

'如果你不希望第一行为"
"工作表为标题行，则将True替换为False （记录集中字段的名称为
'）b
blnHeaderRow = True



'建立EXCEL应用程序对象

On Error Resume Next

设置xlx = GetObject（，"Excel.Application"）

如果Err.Number<> ; 0然后

  &NBSP; &NBSP;设置xlx = CreateObject（" Excel.Application"）

  &NBSP; &NBSP; blnEXCEL = True

结束如果

Err.Clear

On Error GoTo 0



'如果您不希望工作簿在代码运行时可见为b
'，则将True更改为False。
xlx.Visible = True

$
'将C：\ .Filename.xls替换为您要写入数据的EXCEL文件的实际路径和文件名

' b $ b设置xlw = xlx.Workbooks.Open（" O：\CHI-DET-MIN_HUB \ Tech Group \Regional Property Performance Module \Forms\AFS Review Sheet.xltm"）



'将工作表名称替换为EXCEL文件中工作表的实际名称

'

'（注意工作表必须已经在EXCEL文件中）

设置xls = xlw.Worksheets（" P& LThreeYear"）

'用第一个数据值的单元格引用替换A1

'将被写入
设置xlc = xls.Range（" A1"）'这是冷杉数据转入的st单元格


设置dbs = CurrentDb（）



'用真实替换QueryOrTableName表格或查询的名称

'，其数据将写入工作表

Set rst = dbs.OpenRecordset（" q_P& L Three YearDetroit"，dbOpenDynaset， dbReadOnly）

'创建过滤记录集



'开始转移

如果rst.EOF = False和rst。 BOF = False然后是
  &NBSP; &NBSP; rst.MoveFirst



  &NBSP; &NBSP;如果blnHeaderRow = True则为
  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;对于lngColumn = 0到rst.Fields.Count - 1

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; xlc.Offset（0，lngColumn）.Value = rst.Fields（lngColumn）.Name

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;下一个lngColumn

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;设置xlc = xlc.Offset（1,0）

  &NBSP; &NBSP;结束如果



  &NBSP; &NBSP; '将数据写入工作表

  &NBSP; &NBSP;当rst.EOF = False时，
  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;对于lngColumn = 0到rst.Fields.Count - 1

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; xlc.Offset（0，lngColumn）.Value = rst.Fields（lngColumn）.Value

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;下一个lngColumn

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; rst.MoveNext

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;设置xlc = xlc.Offset（1,0）

  &NBSP; &NBSP;循环

结束如果



rst。关闭

Set rst = Nothing

dbs.Close

设置dbs = Nothing

'保存文件时关闭EXCEL文件，并清理EXCEL对象

设置xlc =没有什么是
设置xls =没什么

xlw.Close True  '关闭EXCEL文件并保存新数据

设置xlw = Nothing

如果blnEXCEL = True则xlx.Quit

设置xlx = Nothing

结束功能

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

blnEXCEL = False
' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True

' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set xlx = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True

' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file into which you will write the data
Set xlw = xlx.Workbooks.Open("O:\CHI-DET-MIN_HUB\Tech Group\Regional Property Performance Module\Forms\AFS Review Sheet.xltm")

' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
' (note that the worksheet must already be in the EXCEL file)
Set xls = xlw.Worksheets("P&LThreeYear ")
' Replace A1 with the cell reference into which the first data value
' is to be written
Set xlc = xls.Range("A1") ' this is the first cell into which data go

Set dbs = CurrentDb()

' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
Set rst = dbs.OpenRecordset("q_P&L Three YearDetroit", dbOpenDynaset, dbReadOnly)
'Create filtered recordset

'Begin transfer
If rst.EOF = False And rst.BOF = False Then
      rst.MoveFirst

      If blnHeaderRow = True Then
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
            Next lngColumn
            Set xlc = xlc.Offset(1, 0)
      End If

      ' write data to worksheet
      Do While rst.EOF = False
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
            Next lngColumn
            rst.MoveNext
            Set xlc = xlc.Offset(1, 0)
      Loop
End If

rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close True   ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
End Function

推荐答案

嗨Lavenderchan，

Hi Lavenderchan,

根据您的描述，我认为您希望在将记录集插入模板之前对其进行过滤，对吧？

According to your description,I think that you want to filter your recordset before inserting it to template,right?

您可以使用 Recordset.Filter 来过滤记录集。

You could using Recordset.Filter to filter the recordset.

代码是这样的

Set rst = dbs.OpenRecordset("Select T.CITY,T.COST From TestTable T", dbOpenDynaset, dbReadOnly)

rst.Filter = "Cost>8000 Or Cost<3000"

Set rst = rst.OpenRecordset

参考： Recordset.Filter

Refer to:Recordset.Filter

祝你好运，

Edward

这篇关于如何使用vba从Recordset设置Filter to Data的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！