Filter Recordset-

[Arlan]

I am looking for help, as I am ready to throw my laptop in the
trash...

The following code is used to open a query, send data about the user
to an excel template, save the template as a NEW file, then e-mail via
outlook. I am able to accomplish this by manually filtering the Query
used by my recordset, but I would truly like to be able to loop
through the records via code....

example...

filter for ID=1 (4 records)
Filter for ID=2 (4 records)

Whenever I try to apply the filter to the recordset...it bombs...any
assistance is appreciated. Thanks.

START CODE********

Function MoveData()



Dim objXL As Object
Dim objBook As Object
Dim objSheet As Object
Dim rsData As Recordset
Dim rsFilter As Recordset
Dim i As Integer
Dim i2 As Integer
Dim straddress As String
Dim appOutlook As New Outlook.Application
Dim objItem As Outlook.MailItem
Dim strExcelPath As String
Dim stDocName As String

stDocName = "qryIncentiveReport1"

'This represents the PK filed to filter for
i2 = 1


Set rsData = CurrentDb.OpenRecordset(stDocName, dbOpenSnapshot)
straddress = rsData!userid


'This is where I am lost....

rsData.Filter = "[ID]=" & i2
Set rsFilter = rsData.OpenRecordset

'I now need to Filter this record set, as I need to
'send each users worksheet to them seperately
'Each users worksheet will have between 3 and 6 records per
'spreadsheet.


If rsFilter.EOF = False Then
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
Set objBook = objXL.Workbooks.Open("C:\XLS\IncReport.xls")
Set objSheet = objBook.worksheets("template")
objSheet.Activate
i = 9
With rsFilter
.MoveFirst
Do Until .EOF
objSheet.Range("H3") = !userid
objSheet.Range("B5") = !desc
objSheet.Range("B6") = !PeriodYr
objSheet.Range("B7") = !flight
objSheet.Range("A" & i) = !week
objSheet.Range("B" & i) = !Sales
objSheet.Range("C" & i) = !Lines
objSheet.Range("D" & i) = !stops
objSheet.Range("E" & i) = !linesperstop
objSheet.Range("F" & i) = !minsales
objSheet.Range("G" & i) = !targsales
objSheet.Range("H" & i) = !outsales
objSheet.Range("I" & i) = !minlineinc
objSheet.Range("J" & i) = !targlineinc
objSheet.Range("K" & i) = !outlineinc
i = i + 1
.MoveNext
Loop
End With

'From here I need to then re-query the recordset for the next ID#???

'ReName the worksheet

objXL.Sheets("template").Name = "Sales Incentive Info"

'Save the workbook with the user ID PD and YR

ActiveWorkbook.SaveAs Filename:="C:\XLS\" & Range("H3") & "" &
Range("B6") & ".xls"

'Set the Path to the newly created workbook for e-mail

strExcelPath = "C:\XLS\" & Range("H3") & "" & Range("B6") & ".xls"

'Create New Mail Message

Set objItem = appOutlook.CreateItem(olMailItem)

With objItem
.To = straddress
.Subject = "Sales Incentive Criteria"
.Attachments.Add strExcelPath
.Display
'.Send
End With


Else
MsgBox "There was a problem"
End If

rsData.Close
Set rsData = Nothing
Set objSheet = Nothing
objBook.Close
Set objBook = Nothing
objXL.Quit
Set objXL = Nothing



End Function

 

[Alex Dybenko]

Arlan,
what means "it bombs..."?
anyway - what can also do - either filter recordset while you first open it

"select * from qryIncentiveReport1 where ID=" & i2

or you can sort qryIncentiveReport1 frist by ID, then by what you have now,
and while looping through it you can determine when ID changes

--
Alex Dybenko (MVP)
http://Alex.Dybenko.com
http://www.PointLtd.com

I am looking for help, as I am ready to throw my laptop in the
trash...

The following code is used to open a query, send data about the user
to an excel template, save the template as a NEW file, then e-mail via
outlook. I am able to accomplish this by manually filtering the Query
used by my recordset, but I would truly like to be able to loop
through the records via code....

example...

filter for ID=1 (4 records)
Filter for ID=2 (4 records)

Whenever I try to apply the filter to the recordset...it bombs...any
assistance is appreciated. Thanks.

START CODE********

Function MoveData()



Dim objXL As Object
Dim objBook As Object
Dim objSheet As Object
Dim rsData As Recordset
Dim rsFilter As Recordset
Dim i As Integer
Dim i2 As Integer
Dim straddress As String
Dim appOutlook As New Outlook.Application
Dim objItem As Outlook.MailItem
Dim strExcelPath As String
Dim stDocName As String

stDocName = "qryIncentiveReport1"

'This represents the PK filed to filter for
i2 = 1


Set rsData = CurrentDb.OpenRecordset(stDocName, dbOpenSnapshot)
straddress = rsData!userid


'This is where I am lost....

rsData.Filter = "[ID]=" & i2
Set rsFilter = rsData.OpenRecordset

'I now need to Filter this record set, as I need to
'send each users worksheet to them seperately
'Each users worksheet will have between 3 and 6 records per
'spreadsheet.


If rsFilter.EOF = False Then
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
Set objBook = objXL.Workbooks.Open("C:\XLS\IncReport.xls")
Set objSheet = objBook.worksheets("template")
objSheet.Activate
i = 9
With rsFilter
.MoveFirst
Do Until .EOF
objSheet.Range("H3") = !userid
objSheet.Range("B5") = !desc
objSheet.Range("B6") = !PeriodYr
objSheet.Range("B7") = !flight
objSheet.Range("A" & i) = !week
objSheet.Range("B" & i) = !Sales
objSheet.Range("C" & i) = !Lines
objSheet.Range("D" & i) = !stops
objSheet.Range("E" & i) = !linesperstop
objSheet.Range("F" & i) = !minsales
objSheet.Range("G" & i) = !targsales
objSheet.Range("H" & i) = !outsales
objSheet.Range("I" & i) = !minlineinc
objSheet.Range("J" & i) = !targlineinc
objSheet.Range("K" & i) = !outlineinc
i = i + 1
.MoveNext
Loop
End With

'From here I need to then re-query the recordset for the next ID#???

'ReName the worksheet

objXL.Sheets("template").Name = "Sales Incentive Info"

'Save the workbook with the user ID PD and YR

ActiveWorkbook.SaveAs Filename:="C:\XLS\" & Range("H3") & "" &
Range("B6") & ".xls"

'Set the Path to the newly created workbook for e-mail

strExcelPath = "C:\XLS\" & Range("H3") & "" & Range("B6") & ".xls"

'Create New Mail Message

Set objItem = appOutlook.CreateItem(olMailItem)

With objItem
.To = straddress
.Subject = "Sales Incentive Criteria"
.Attachments.Add strExcelPath
.Display
'.Send
End With


Else
MsgBox "There was a problem"
End If

rsData.Close
Set rsData = Nothing
Set objSheet = Nothing
objBook.Close
Set objBook = Nothing
objXL.Quit
Set objXL = Nothing



End Function

 

[John Nurick]

Hi Arlan,

Just build a SQL SELECT statement on the fly and use that to open a
recordset containing the records for a particular user. Something like
this:

Dim rsUsers As DAO.Recordset
Dim rsExport As DAO.Recordset
Dim strQuery As String
Dim lngUser As Long
....

strQuery = "qryIncentiveReport1"
Set rsUsers = CurrentDB.OpenRecordset( _
"SELECT DISTINCT UserID FROM " & strQuery & ";")

Do Until rsUsers.EOF
rsExport = CurrentDB.OpenRecordset("SELECT * FROM " _
& strQuery & " WHERE UserID=" _
& rsUsers.Fields("UserID").Value _
& "ORDER BY Blah;")
'Now export rsExport to Excel
...
...
'Next user
rsUsers.MoveNext
Loop

I am looking for help, as I am ready to throw my laptop in the
trash...

The following code is used to open a query, send data about the user
to an excel template, save the template as a NEW file, then e-mail via
outlook. I am able to accomplish this by manually filtering the Query
used by my recordset, but I would truly like to be able to loop
through the records via code....

example...

filter for ID=1 (4 records)
Filter for ID=2 (4 records)

Whenever I try to apply the filter to the recordset...it bombs...any
assistance is appreciated. Thanks.

START CODE********

Function MoveData()



Dim objXL As Object
Dim objBook As Object
Dim objSheet As Object
Dim rsData As Recordset
Dim rsFilter As Recordset
Dim i As Integer
Dim i2 As Integer
Dim straddress As String
Dim appOutlook As New Outlook.Application
Dim objItem As Outlook.MailItem
Dim strExcelPath As String
Dim stDocName As String

stDocName = "qryIncentiveReport1"

'This represents the PK filed to filter for
i2 = 1


Set rsData = CurrentDb.OpenRecordset(stDocName, dbOpenSnapshot)
straddress = rsData!userid


'This is where I am lost....

rsData.Filter = "[ID]=" & i2
Set rsFilter = rsData.OpenRecordset

'I now need to Filter this record set, as I need to
'send each users worksheet to them seperately
'Each users worksheet will have between 3 and 6 records per
'spreadsheet.


If rsFilter.EOF = False Then
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
Set objBook = objXL.Workbooks.Open("C:\XLS\IncReport.xls")
Set objSheet = objBook.worksheets("template")
objSheet.Activate
i = 9
With rsFilter
.MoveFirst
Do Until .EOF
objSheet.Range("H3") = !userid
objSheet.Range("B5") = !desc
objSheet.Range("B6") = !PeriodYr
objSheet.Range("B7") = !flight
objSheet.Range("A" & i) = !week
objSheet.Range("B" & i) = !Sales
objSheet.Range("C" & i) = !Lines
objSheet.Range("D" & i) = !stops
objSheet.Range("E" & i) = !linesperstop
objSheet.Range("F" & i) = !minsales
objSheet.Range("G" & i) = !targsales
objSheet.Range("H" & i) = !outsales
objSheet.Range("I" & i) = !minlineinc
objSheet.Range("J" & i) = !targlineinc
objSheet.Range("K" & i) = !outlineinc
i = i + 1
.MoveNext
Loop
End With

'From here I need to then re-query the recordset for the next ID#???

'ReName the worksheet

objXL.Sheets("template").Name = "Sales Incentive Info"

'Save the workbook with the user ID PD and YR

ActiveWorkbook.SaveAs Filename:="C:\XLS\" & Range("H3") & "" &
Range("B6") & ".xls"

'Set the Path to the newly created workbook for e-mail

strExcelPath = "C:\XLS\" & Range("H3") & "" & Range("B6") & ".xls"

'Create New Mail Message

Set objItem = appOutlook.CreateItem(olMailItem)

With objItem
.To = straddress
.Subject = "Sales Incentive Criteria"
.Attachments.Add strExcelPath
.Display
'.Send
End With


Else
MsgBox "There was a problem"
End If

rsData.Close
Set rsData = Nothing
Set objSheet = Nothing
objBook.Close
Set objBook = Nothing
objXL.Quit
Set objXL = Nothing



End Function

 

[Jamie Collins]

Just build a SQL SELECT statement on the fly and use that to open a
recordset containing the records for a particular user.

I originally thought the OP said "loop through the recordsets", which
got me thinking of a hierarchical recordset i.e. a recordset with a
field that returns a child recordset for each row.

Here's a stripped-down example which creates a test database (in Excel
merely because it easier to create an .xls on the fly than an .mdb):

Sub Test()

Dim Con As Object
Dim Rs As Object
Dim strSql As String

Const CONN_STRING = "" & _
"Provider=MSDataShape;" & _
"Data Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Test.xls;" & _
"Extended Properties='Excel 8.0;HDR=YES'"

Set Con = CreateObject("ADODB.Connection")

With Con

' Open connection to workbook
' (will get created if non-existent)
.CursorLocation = 3 ' adUseClient
.ConnectionString = CONN_STRING
.Open

' Create test table
On Error Resume Next
.Execute "DROP TABLE qryIncentiveReport1"
On Error GoTo 0
.Execute "" & _
"CREATE TABLE qryIncentiveReport1 (" & _
" ID INTEGER NULL," & _
" userid VARCHAR(255) NULL," & _
" PeriodYr INTEGER NULL," & _
" flight VARCHAR(255)" & _
");"

' Create test data
.Execute "" & _
"INSERT INTO qryIncentiveReport1" & _
" (ID, userid, PeriodYr, flight)" & _
" VALUES (1,'AB123',4,'Turbulent');"
.Execute "" & _
"INSERT INTO qryIncentiveReport1" & _
" (ID, userid, PeriodYr, flight)" & _
" VALUES (2,'CD456',2,'Long haul');"
.Execute "" & _
"INSERT INTO qryIncentiveReport1" & _
" (ID, userid, PeriodYr, flight)" & _
" VALUES (3,'EE777',6,'Turboprop');"

' Create hierarchical recordset
strSql = "" & _
"SHAPE {" & _
"SELECT ID, userid, PeriodYr, flight" & _
" FROM qryIncentiveReport1" & _
"} AS rsChild" & _
" COMPUTE rsChild BY ID"

Set Rs = .Execute(strSql)

' Disconnect and close connection
Rs.ActiveConnection = Nothing
.Close

End With

With Rs

' Create child recordsets using
' disconnected parent recordset
Dim RsTemp As Object

Dim lngRows As Long
lngRows = .RecordCount

Dim lngCounter As Long
For lngCounter = 0 To lngRows - 1

Set RsTemp = .Fields("rsChild").Value

' Do something with this recordset e.g.
MsgBox RsTemp.GetString

.MoveNext

Next

End With

End Sub


Jamie.

--