如何複製和過濾VBA中的DAO記錄集？

由於DAO存在問題（請參閱my previous question），我需要從Access查詢創建Excel VBA Recordset並使用用戶定義的函數過濾其結果。如何複製和過濾VBA中的DAO記錄集？

我想我可以使用下面的代碼來實現：

Sub test() 

Dim db As Database 
Dim rs As Recordset 
Dim rs_clone As Recordset 

Set db = OpenDatabase(dbPath) 
Set rs = db.OpenRecordset("select testVal from dataTable") 
Set rs_clone = rs.Clone 
rs_clone.MoveLast 
rs_clone.MoveFirst 
while not rs_clone.eof 
if myUDF(rs_clone!testVal) then 
    rs_clone.delete 
end if 
rs_clone.moveNext 
wend 

End Sub

但是，這實際上是從我的源表中刪除值，因此克隆是不是一個新的記錄，我可以自由地改變，它只是另一個指向原始指針的指針。如何將UDF過濾掉我不想要的記錄，同時保留原始數據不變，如果將UDF放入查詢本身不是一個選項？

來源

2011-08-18 sigil

17個問題，只有3個上傳投。 –

@Mitch，什麼時候適合upvote？如果我選擇一個答案，那是否完成同樣的事情？ – sigil

記錄集具有篩選器屬性，因此您可以創建一個新的記錄集，該記錄集是現有記錄集的篩選版本。 –

使用.getrows方法：

Dim rs_clone As Variant 

... 

rs_clone = rs.getrows(numrows)

然後處理所得的2-d陣列。

來源

2011-08-18 00:50:02

與DAO訪問，這是你會怎麼做：

Dim db As DAO.Database 
    Dim rs As DAO.Recordset 
    Dim rsFiltered As DAO.Recordset 

    Set db = CurrentDb 
    Set rs = db.OpenRecordset("SELECT tblInventory.* FROM tblInventory;") 
    rs.MoveLast 
    Debug.Print "Unfiltered: " & rs.RecordCount 

    rs.filter = "[LastUpdated]>=#1/1/2011#" 
    Set rsFiltered = rs.OpenRecordset 
    rsFiltered.MoveLast 
    Debug.Print "Filtered: " & rsFiltered.RecordCount 

    rsFiltered.Close 
    Set rsFiltered = Nothing 
    rs.Close 
    Set rs = Nothing 
    Set db = Nothing

但是，請注意（這在幫助文件中提到的），它可能只是作爲快速簡單地重新打開記錄與新的標準，而不是過濾現有的記錄集。

來源

2011-08-22 00:37:32

有趣;我不知道.Filter屬性。我必須檢查一下，看看它是否比我想出的要快。 – sigil

Option Compare Database 

Private Sub Command0_Click() 
Sub Export_Click() 

Dim db As Database, rs As Recordset, sql As String, r As Variant 

Dim appExcel As Excel.Application 
Dim excelWbk As Excel.Workbook 
Dim excelSht As Object 
Dim rng As Excel.Range 

Set appExcel = New Excel.Application 
On Error Resume Next 
Set excelWbk = appExcel.Workbooks.Open("Folder Name(Template)") 

Set db = CurrentDb() 
sql1 = "Select * from Query_New" 
sql2 = "Select * from Query_Expired" 
Set rs1 = db.OpenRecordset(sql1, dbReadOnly) 
Set rs2 = db.OpenRecordset(sql2, dbReadOnly) 

Dim SheetName1 As String 
Dim SheetName2 As String 

SheetName1 = "New" 
SheetName2 = "Expired" 

'For first sheet 
On Error Resume Next 
excelWbk.Sheets(SheetName1).Select 

If Err.Number <> 0 Then 
MsgBox Err.Number 
excelWbk.Close False 
appExcel.Quit 
Exit Sub 
End If 

With excelWbk.Activesheet 
    .Cells(5, 1).CopyFromRecordset rs1 
    On Error GoTo 0 
End With 

'For second sheet 
On Error Resume Next 
excelWbk.Sheets(SheetName2).Select 

If Err.Number <> 0 Then 
MsgBox Err.Number 
excelWbk.Close False 
appExcel.Quit 
Exit Sub 
End If 

With excelWbk.Activesheet 
    .Cells(5, 1).CopyFromRecordset rs2 
    On Error GoTo 0 
End With 


rs1.Close 
Set rs1 = Nothing 
rs2.Close 
Set rs2 = Nothing 
db.Close 
Set db = Nothing 

On Error Resume Next 

excelWbk.SaveAs "C:\Documents and settings\" & Environ("UserName") & "\Desktop\Decision.xlsx" 

If Err.Number <> 0 Then 
MsgBox Err.Number 
End If 

excelWbk.Close False 
appExcel.Quit 
Set appExcel = Nothing 
MsgBox "The report has been saved" 
End Sub 




End Sub

來源

2014-02-21 05:42:33 user1934049

如何複製和過濾VBA中的DAO記錄集？

回答

相關問題