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:
Code:
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