Amour22015
asked on
Access 2007, Report Loops
Thank you!
I have a send object command that send a report. The problem I am having is that the rptCSM report loops to the bound table? How I know this is when I go to the email the report will have the same amount of pages as there are records to the rptCSM bound Table. There should only be one page to the rptCSM report.
I have this logic and I think I am filtering correctly:
'Check if in the SCGTable
Set rsSCGTable = New ADODB.Recordset
sSQLSCGTable = "Select * from SCGTable where SCGNumber = '" & TxtSCGID & "'"
rsSCGTable.Open sSQLSCGTable, CurrentProject.Connection
If rsSCGTable.EOF Then
message
Else
DoCmd.OpenReport "RptCSM", , , "SCGNumber = " & "'" & TxtSCGID & "'", acHidden
DoCmd.SendObject acSendReport, "RptCSM", "Rich Text Format",
DoCmd.Close acReport, "RptCSM"
End If
As you can see this is in ADO Verison 6.0
Also when I try this there is some small sized menus that come up and I don't want to see them?
Thank You!
I have a send object command that send a report. The problem I am having is that the rptCSM report loops to the bound table? How I know this is when I go to the email the report will have the same amount of pages as there are records to the rptCSM bound Table. There should only be one page to the rptCSM report.
I have this logic and I think I am filtering correctly:
'Check if in the SCGTable
Set rsSCGTable = New ADODB.Recordset
sSQLSCGTable = "Select * from SCGTable where SCGNumber = '" & TxtSCGID & "'"
rsSCGTable.Open sSQLSCGTable, CurrentProject.Connection
If rsSCGTable.EOF Then
message
Else
DoCmd.OpenReport "RptCSM", , , "SCGNumber = " & "'" & TxtSCGID & "'", acHidden
DoCmd.SendObject acSendReport, "RptCSM", "Rich Text Format",
DoCmd.Close acReport, "RptCSM"
End If
As you can see this is in ADO Verison 6.0
Also when I try this there is some small sized menus that come up and I don't want to see them?
Thank You!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Here is another method of creating a filtered report for each member of a recordset:
Public Sub SendInterventionEmails()
'Created by Helen Feddema 10-Jan-2010
'Last modified by Helen Feddema 10-Jan-2010
On Error GoTo ErrorHandler
Dim appOutlook As New Outlook.Application
Dim itm As Outlook.MailItem
Dim rstIntervention As DAO.Recordset
Dim lngCount As Long
Dim lngID As Long
Dim rpt As Access.Report
Dim strFileName As String
Dim strPrompt As String
Dim strQuery As String
Dim strRecordSource As String
Dim strReport As String
Dim strSQL As String
Dim strTitle As String
Dim strCurrentPath As String
Dim strFileNameAndPath As String
Dim strEmailSource As String
strEmailSource = "qryInterventionEmail"
strRecordSource = "qryMissingAssignments"
strQuery = "qryMissingAssignmentsSingleStudent"
Set dbs = CurrentDb
Set rstIntervention = dbs.OpenRecordset(strEmailSource)
strCurrentPath = Application.CurrentProject.Path & "\"
'Use path selected with SelectFolder procedure
'strCurrentPath = SelectFolder()
With rstIntervention
Do While Not .EOF
lngID = ![StID]
Debug.Print "Processing Student ID " & lngID
strFileName = "Intervention Report for " & ![StFirst] _
& " " & ![StLast] & ".pdf"
strFileNameAndPath = strCurrentPath & strFileName
'Create filtered query
strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _
& "[StID] = " & Chr(39) & lngID & Chr(39) & ";"
Debug.Print "SQL for " & strQuery & ": " & strSQL
lngCount = CreateAndTestQuery(strQuery, strSQL)
Debug.Print "No. of items found: " & lngCount
If lngCount = 0 Then
GoTo NextStudent
End If
'Open report with filtered query record source
strReport = "rptMissingAssignmentsNew"
DoCmd.OpenReport ReportName:=strReport, _
View:=acViewPreview, _
windowmode:=acWindowNormal
Set rpt = Reports(strReport)
DoCmd.OutputTo objecttype:=acOutputReport, _
objectname:=strReport, _
outputformat:=acFormatPDF, _
outputfile:=strFileNameAndPath
'Create email
Set itm = appOutlook.CreateItem(olMailItem)
itm.Subject = "MISSING WORK"
itm.Body = "The attached file lists your missing assignments"
itm.To = ![Email]
itm.Attachments.Add Source:=strFileNameAndPath, _
Type:=olByValue
'For editing before sending
itm.Display
'For sending automatically
'itm.Send
DoCmd.Close objecttype:=acReport, _
objectname:=strReport, _
Save:=acSaveNo
NextStudent:
.MoveNext
Loop
End With
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in SendInterventionEmails procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Public Function CreateAndTestQuery(strTestQuery As String, _
strTestSQL As String) As Long
'Created by Helen Feddema 28-Jul-2002
'Last modified by Helen Feddema 10-Jan-2010
On Error Resume Next
'Delete old query
Set dbs = CurrentDb
dbs.QueryDefs.Delete strTestQuery
On Error GoTo ErrorHandler
'Create new query
Set qdf = dbs.CreateQueryDef(strTestQuery, strTestSQL)
'Test whether there are any records
Set rst = dbs.OpenRecordset(strTestQuery)
With rst
.MoveFirst
.MoveLast
CreateAndTestQuery = .RecordCount
End With
ErrorHandlerExit:
Exit Function
ErrorHandler:
If Err.Number = 3021 Then
CreateAndTestQuery = 0
Resume ErrorHandlerExit
Else
MsgBox "Error No: " & Err.Number _
& " in CreateAndTestQuery procedure; " _
& "Description: " & Err.Description
End If
End Function
ASKER
Great Thank you!
There is no way to include selection criteria in a sendobject command.
You have to be sending an object which does its own selection.
I think you will have to look at changing the recordsource for your report to one which includes a selection parameter.