Edit VBA programming for running multiple reports

[jennifers]

I have code that a previous programmer created that runs through many different reports and parameters and is prompting my user at each change. I am trying to see if I can remove the prompts and let it run through all of the reports automatically. The code that this set of reports runs on is:

Public Sub Report_Script(intView As Integer, Optional blnMin As Boolean)
On Error GoTo Err_Handler


    Dim rst As Recordset, rstClone As Recordset, fld As Field
    Dim dbs As Database, qdf As QueryDef, strSQL As String
    Dim rstScript As Recordset, intUnitNum As Integer
    Dim Prompt As String, Buttons As Integer, Title As String, Response As Integer
    Dim tmpPrinter As Printer, PDFPrintDriver As String


    Set dbs = CurrentDb
    Set rstClone = Me.RecordsetClone
    Set qdf = dbs.QueryDefs("qryReport_Scripts")
    qdf.Parameters("[Forms]![Report Options]![cboUnitNum]") = [Forms]![Report Options]![cboUnitNum]
    Set rstScript = qdf.OpenRecordset
    
    RunCommand acCmdSaveRecord
    
'    Recompile_Summary_Tables Me.txtFromDate, Me.txtThruDate, Me.cboReport


    If Int(SysCmd(acSysCmdAccessVer)) >= 10 Then
        PDFPrintDriver = DLookup("PDFPrintDriver", "Defaults")
        Set tmpPrinter = Application.Printer
        Application.Printer = Application.Printers(PDFPrintDriver)
    End If
    
    'Backup Defaults table.
    strSQL = "DELETE * FROM Defaults_Backup;"
    dbs.Execute strSQL, dbFailOnError


    strSQL = "INSERT INTO Defaults_Backup SELECT Defaults.* FROM Defaults;"
    dbs.Execute strSQL, dbFailOnError


    With rstScript
    Do
        If intUnitNum <> !UnitNum Then
            intUnitNum = !UnitNum
            Title = "Print Unit Reports?"
            Prompt = "Print reports for " & !ReportHeaderName & "?"
            Buttons = vbYesNoCancel
            Response = MsgBox(Prompt, Buttons, Title)
        End If


        Select Case Response
            Case vbYes
                Me.cboReport = !ReportName
                Me.ReportHeaderName = !ReportHeaderName
                Me.cboUnitNum = !cboUnitNum
                Me.cboSubUnitNum = !cboSubUnitNum
                Me.cboDiversionPointNum = !cboDiversionPointNum
                Me.cboDiversionPointGroup = !cboDiversionPointGroup
                Me.Frame_Total_For = !Frame_Total_For


                If Application.CurrentProject.AllReports(Me.cboReport).IsLoaded Then
                    Title = "Previous Report Open"
                    Prompt = "There is still a previous instance of the " & Me.cboReport & " report open. " _
                        & "It will be closed when you press OK. To quit now, press Cancel. "
                    Buttons = vbOKCancel
                    Response = MsgBox(Prompt, Buttons, Title)


                    Select Case Response
                        Case vbOK
                            DoCmd.Close acReport, Me.cboReport
                        Case vbCancel
                            Exit Do
                    End Select
                End If


                Report_Prep intView, True


            Case vbNo


            Case vbCancel
                Exit Do
        End Select
        .MoveNext
    Loop Until .EOF
    End With
    
    If Int(SysCmd(acSysCmdAccessVer)) >= 10 Then
        Application.Printer = tmpPrinter
    End If


    Set rst = dbs.TableDefs("Defaults_Backup").OpenRecordset
    
    With rst
    Me.cboReport = !ReportName
    Me.FrameDataStatus = !DataStatus
    Me.cboUnitNum = !DefaultUnitNum
    Me.cboSubUnitNum = !DefaultSubUnitNum
    Me.cboDiversionPointNum = !DefaultDiversionPointNum
    Me.cboDiversionPointGroup = !DefaultDiversionPointGroup
    Me.Frame_Total_For = !TotalFor
    Me.ReportHeaderName = !ReportHeaderName
    End With
    
    Title = "Report Script Done"
    Prompt = "Done printing " & Me.cboReport & " for " & Nz(Me.cboUnitNum.Column(2), "[Unknown Unit]") & " for " & Me.txtFromDate & " through " & Me.txtThruDate & "."
    Buttons = vbOKOnly
    MsgBox Prompt, Buttons, Title
    
    
Exit_Handler:
    Exit Sub


Err_Handler:
    MsgBox Err.Description
    Resume Exit_Handler
    Resume Next
End Sub

[June7]

Sure. If you don't want user to have option to cancel process or verify each step, remove all the MsgBox code and the Select Case.

For future, please post lengthy code between CODE tags to retain indentation and readability. You could edit this post to fix.

[jennifers]

Thank you June, I tried that and it appears to start the export to PDF then it throws the error "KRWA Reporting Module can't find the 'UnitNum' referred to in your expression." I know that he has a table and query full of different reports and report parameters that it goes through. There is a total of 137. I can't figure out what part of the code it needs to keep going down the list for each report to generate it. The only one it exported in this instance is the very first one on the list.

[June7]

You could post your revised code for analysis. Is it like:

Public Sub Report_Script(intView As Integer, Optional blnMin As Boolean)
On Error GoTo Err_Handler
    Dim rst As Recordset, rstClone As Recordset, fld As Field
    Dim dbs As Database, qdf As QueryDef, strSQL As String
    Dim rstScript As Recordset, intUnitNum As Integer
    Dim tmpPrinter As Printer, PDFPrintDriver As String
    Set dbs = CurrentDb
    Set rstClone = Me.RecordsetClone
    Set qdf = dbs.QueryDefs("qryReport_Scripts")
    qdf.Parameters("[Forms]![Report Options]![cboUnitNum]") = [Forms]![Report Options]![cboUnitNum]
    Set rstScript = qdf.OpenRecordset
    
    RunCommand acCmdSaveRecord
    
    If Int(SysCmd(acSysCmdAccessVer)) >= 10 Then
        PDFPrintDriver = DLookup("PDFPrintDriver", "Defaults")
        Set tmpPrinter = Application.Printer
        Application.Printer = Application.Printers(PDFPrintDriver)
    End If
    
    'Backup Defaults table.
    strSQL = "DELETE * FROM Defaults_Backup;"
    dbs.Execute strSQL, dbFailOnError
    strSQL = "INSERT INTO Defaults_Backup SELECT Defaults.* FROM Defaults;"
    dbs.Execute strSQL, dbFailOnError
    With rstScript
    Do
        If intUnitNum <> !UnitNum Then
            intUnitNum = !UnitNum
        End If
        Me.cboReport = !ReportName
        Me.ReportHeaderName = !ReportHeaderName
        Me.cboUnitNum = !cboUnitNum
        Me.cboSubUnitNum = !cboSubUnitNum
        Me.cboDiversionPointNum = !cboDiversionPointNum
        Me.cboDiversionPointGroup = !cboDiversionPointGroup
        Me.Frame_Total_For = !Frame_Total_For
        If Application.CurrentProject.AllReports(Me.cboReport).IsLoaded Then
            DoCmd.Close acReport, Me.cboReport
        End If
        Report_Prep intView, True
        .MoveNext
    Loop Until .EOF
    End With
    
    If Int(SysCmd(acSysCmdAccessVer)) >= 10 Then
        Application.Printer = tmpPrinter
    End If
    Set rst = dbs.TableDefs("Defaults_Backup").OpenRecordset
    
    With rst
    Me.cboReport = !ReportName
    Me.FrameDataStatus = !DataStatus
    Me.cboUnitNum = !DefaultUnitNum
    Me.cboSubUnitNum = !DefaultSubUnitNum
    Me.cboDiversionPointNum = !DefaultDiversionPointNum
    Me.cboDiversionPointGroup = !DefaultDiversionPointGroup
    Me.Frame_Total_For = !TotalFor
    Me.ReportHeaderName = !ReportHeaderName
    End With
    
Exit_Handler:
    Exit Sub
Err_Handler:
    MsgBox Err.Description
    Resume Exit_Handler
    Resume Next
End Sub

[jennifers]

Good Morning June,
Yes that exact code you pasted yields the same results. Error looking for UnitNum and only one page first report in table listing. But it does try to keep going to make other PDFs regardless of error. We were hoping to generate all of the reports as one PDF export.

[June7]

Didn't change recordset code. If it was find UnitNum before it should still find it.

If you want to merge reports into one PDF that will require code manipulating PDF files.

If you want to provide db for analysis, follow instructions at bottom of my post.