DEVelopers HUT

'---------------------------------------------------------------------------------------
' Procedure : RptPrntSetDef
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Ensure that all the report apge setups are set to use the Default Printer
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2011-05-23              Initial Release
'---------------------------------------------------------------------------------------
Sub RptPrntSetDef()
    On Error GoTo Error_Handler
    Dim db               As DAO.Database
    Dim DbP              As Object
    Dim DbO              As AccessObject
 
    Set db = CurrentDb
    DoCmd.SetWarnings False
    Debug.Print "RptPrntSetDef Begin"
    Debug.Print "================================================================================"
    'Check Reports
    Set DbP = application.CurrentProject
    For Each DbO In DbP.AllReports
        DoCmd.OpenReport DbO.Name, acDesign
        If Reports(DbO.Name).Report.UseDefaultPrinter = False Then
            Debug.Print "Editing Report '" & DbO.Name & "'"
            Reports(DbO.Name).Report.UseDefaultPrinter = True
            DoCmd.Close acReport, DbO.Name, acSaveYes
        Else
            DoCmd.Close acReport, DbO.Name, acSaveNo
        End If
    Next DbO
    Debug.Print "================================================================================"
    Debug.Print "RptPrntSetDef End"
 
Error_Handler_Exit:
    On Error Resume Next
    DoCmd.SetWarnings True
    Set DbO = Nothing
    Set DbP = Nothing
    Set db = Nothing
    Exit Sub
 
Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: RptPrntSetDef" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Sub