Code not cycling!!

  • Thread starter Thread starter Antney
  • Start date Start date
A

Antney

Hi,

I have code that turns my Access reports into PDFs but for some reason when
the filter in the code gets done with one school, it should start at the next
school in the list but the code starts all over again at the first school. So
the code goes through the table but always starts at the first school instead
of cycling through all of them until the end of file. Can anyone help me
figure this out? I want the code to go through all of the schools in the
table.

Thanks!!!

Here is my code:

Option Compare Database
Option Explicit

Private Sub cmdConvertReportsToPDF_Click()
On Error GoTo Err_cmdConvertReportsToPDF_Click

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strReport As String
Dim strDocName As String
Dim blRet As Boolean
Dim strDocFolder As String
Dim strFilter As String

Set db = CurrentDb()
'Recordsource
Set rs = db.OpenRecordset("SnapshotData_Elem")

'Report
strReport = "rptStudentSnapshot_Elem"
'Path to output PDFs
strDocFolder = "Z:\RAADataSupport\Student Snapshots\Student Snapshot
Elementary\"

Do Until rs.EOF
'Labels the PDF file with the school name
strDocName = strDocFolder & "Student Snapshot Fall 2008 " &
rs!SiteName & ".pdf"
'Recordsource school id matches report school id
strFilter = "School=" & rs!School
DoCmd.OpenReport strReport, acViewPreview, , strFilter,
acHidden
If Reports(strReport).HasData Then
'Calls the ConvertReportToPDF function
blRet = ConvertReportToPDF(strReport, vbNullString,
strDocName, False, False, 150, "", "", 0, 0, 0)
rs.MoveNext
End If
DoCmd.Close acReport, strReport
Loop
rs.Close

Exit_cmdConvertReportsToPDF_Click:
'Cleanup
On Error Resume Next
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing

Exit Sub

Err_cmdConvertReportsToPDF_Click:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in Test subroutine..."
Resume Exit_cmdConvertReportsToPDF_Click
End Sub
 
You've got rs.MoveNext in the wrong place, move it so that it is on the line
immediately before the Loop statement.
 
Hi and thanks. I tried what you suggested but it still wants to start at the
beginning of the recordset once each time it cycles through.

Any suggestions???

Here's my new code:

Option Compare Database
Option Explicit

Private Sub cmdConvertReportsToPDF_Click()
On Error GoTo Err_cmdConvertReportsToPDF_Click

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strReport As String
Dim strDocName As String
Dim blRet As Boolean
Dim strDocFolder As String
Dim strFilter As String

Set db = CurrentDb()
'Recordsource
Set rs = db.OpenRecordset("SnapshotData_Elem")

'Report
strReport = "rptStudentSnapshot_Elem"
'Path to output PDFs
strDocFolder = "Z:\RAADataSupport\Student Snapshots\Student Snapshot
Elementary\"

Do Until rs.EOF
'Labels the PDF file with the school name
strDocName = strDocFolder & "Student Snapshot Fall 2008 " &
rs!SiteName & ".pdf"
'Recordsource school id matches report school id
strFilter = "School=" & rs!School
DoCmd.OpenReport strReport, acViewPreview, , strFilter,
acHidden
If Reports(strReport).HasData Then
'Calls the ConvertReportToPDF function
blRet = ConvertReportToPDF(strReport, vbNullString,
strDocName, False, False, 150, "", "", 0, 0, 0)
End If
DoCmd.Close acReport, strReport
rs.MoveNext
Loop
rs.Close

Exit_cmdConvertReportsToPDF_Click:
'Cleanup
On Error Resume Next
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing

Exit Sub

Err_cmdConvertReportsToPDF_Click:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in Test subroutine..."
Resume Exit_cmdConvertReportsToPDF_Click
End Sub
 
You rs.MoveNext line is in the correct spot inside the Do Until... Loop.
Were it not inside the loop, the code would loop endlessly as there would be
nothing to move the recordset to the next record--and eventually to the end
of the recordset--to force the code out of the loop.

I've not pulled the code into a test database to run it myself, but on the
surface, I do not see anything wrong with it.

A couple of suggestions:

1) Change this line:
DoCmd.Close acReport, strReport
to
DoCmd.Close acReport, strReport, acSaveNo

2) Open your report in design view and make sure that there is no filter
saved. If there is, remove it and save the report. I have seen instances
where an existing filter on a form prevented a new filter from being applied
via the DoCmd.OpenForm method. There might be similar issues with reports.

That's all I have, for what it's worth, anyway. Someone with more
experience and knowledge than I possess may likely be able to offer more
meaningful help.

-Jeff
 
Thank you, I've figured it out.

It was because I had an average of 120 rows per school and there were 20,000
rows. I had to group them first by school number and name.

Here's my code if it helps anyone:

Option Compare Database
Option Explicit

Private Sub cmdConvertReportsToPDF_Click()
On Error GoTo Err_cmdConvertReportsToPDF_Click

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strReport As String
Dim strDocName As String
Dim blRet As Boolean
Dim strDocFolder As String
Dim strFilter As String

Set db = CurrentDb()
'Recordsource
Set rs = db.OpenRecordset("Select distinct SiteName, SchoolNum from
SDR_ELA")

'Report
strReport = "rptSDR_ELA"
'Path to output PDFs
strDocFolder = "Z:\RAADataSupport\dbMiniSDR\ELA\"

Do Until rs.EOF
'Labels the PDF file with the school name
strDocName = strDocFolder & "Student Data Roster ELA Fall
2008 " & rs!SiteName & ".pdf"
'Recordsource school id matches report school id
strFilter = "SchoolNum=" & rs!SchoolNum
DoCmd.OpenReport strReport, acViewPreview, , strFilter,
acHidden
rs.MoveNext
If Reports(strReport).HasData Then
'Calls the ConvertReportToPDF function
blRet = ConvertReportToPDF(strReport, vbNullString,
strDocName, False, False, 150, "", "", 0, 0, 0)
End If
DoCmd.Close acReport, strReport
Loop
rs.Close

Exit_cmdConvertReportsToPDF_Click:
'Cleanup
On Error Resume Next
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing

Exit Sub

Err_cmdConvertReportsToPDF_Click:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in Test subroutine..."
Resume Exit_cmdConvertReportsToPDF_Click
End Sub
 
Back
Top