DEVelopers HUT

'---------------------------------------------------------------------------------------
' Procedure : IsRptOpen
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine whether a report is open or not
' 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).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sRptName  : Name of the report to check if it is open or not
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' IsRptOpen("Report1")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-May-26                 Initial Release
'---------------------------------------------------------------------------------------
Function IsRptOpen(sRptName As String) As Boolean
On Error GoTo Error_Handler
 
    If Application.CurrentProject.AllReports(sRptName).IsLoaded = True Then
        IsRptOpen = True
    Else
        IsRptOpen = False
    End If
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: IsRptOpen" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : DoesRptExist
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine if the specified report exists or not in the current database
' 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).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sReportName : Name of the report to check the existance of
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' DoesRptExist("Report1")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Feb-02             Initial Release
'---------------------------------------------------------------------------------------
Function DoesRptExist(sReportName As String) As Boolean
   Dim rpt  As Object
 
On Error GoTo Error_Handler
   'Initialize our variable
   DoesRptExist = False
 
   Set rpt = CurrentProject.AllReports(sReportName)
 
   DoesRptExist = True  'If we made it to here without triggering an error
                        'the report exists

Error_Handler_Exit:
   On Error Resume Next
   Set rpt = Nothing
   Exit Function
 
Error_Handler:
   If Err.Number = 2467 Then
      'If we are here it is because the report could not be found
   Else
      MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
      Err.Number & vbCrLf & "Error Source: DoesRptExist" & vbCrLf & "Error Description: " & _
      Err.Description, vbCritical, "An Error has Occured!"
   End If
   Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : CountOpenRpts
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Returns a count of the number of loaded reports (preview or design)
' 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.
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Oct-30                 Initial Release
' 2         2009-Oct-31                 Switched from AllReports to Reports collection
'---------------------------------------------------------------------------------------
Function CountOpenRpts()
On Error GoTo Error_Handler
 
    CountOpenRpts = Application.Reports.Count
 
Exit Function
 
Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: CountOpenRpts" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Exit Function
End Function

'---------------------------------------------------------------------------------------
' Procedure : ListOpenRpts
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Returns a list of all the loaded reports (preview or design)
'             separated by ; (ie: Report1;Report2;Report3)
' 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.
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Oct-30                 Initial Release
' 2         2009-Oct-31                 Switched from AllReports to Reports collection
'---------------------------------------------------------------------------------------
Function ListOpenRpts()
On Error GoTo Error_Handler
 
    Dim DbR     As Report
    Dim DbO     As Object
    Dim Rpts    As Variant
 
    Set DbO = Application.Reports
 
    For Each DbR In DbO    'Loop all the reports
            Rpts = Rpts & ";" & DbR.Name
    Next DbR
 
    If Len(Rpts) > 0 Then
        Rpts = Right(Rpts, Len(Rpts) - 1)   'Truncate initial ;
    End If
 
    ListOpenRpts = Rpts
 
Exit Function
 
Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: ListOpenRpts" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Exit Function
End Function

'---------------------------------------------------------------------------------------
' Procedure : ListDbRpts
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Returns a ';' separated string containing the names of all the reports
'             within the database (use Split() to convert the string to an array)
' 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         2007-Nov                 Initial Release
'---------------------------------------------------------------------------------------
Function ListDbRpts() As String
On Error GoTo Error_Handler
 
    Dim DbO     As AccessObject
    Dim DbP     As Object
    Dim Rpts    As String
 
    Set DbP = Application.CurrentProject
 
    For Each DbO In DbP.AllReports
        Rpts = Rpts & ";" & DbO.Name
    Next DbO
    Rpts = Right(Rpts, Len(Rpts) - 1) 'Truncate initial ;
   
    ListDbRpts = Rpts
 
Exit Function
 
Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: ListDbRpts" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Exit Function
End Function

docmd.RunCommand acCmdPrint

Set Application.Printer = Application.Printers("HP LaserJet Series II")

Dim strDefaultPrinter  as string
 
' get current default printer.
strDefaultPrinter = Application.Printer.DeviceName
 
' switch to printer of your choice:
Set Application.Printer = Application.Printers("HP LaserJet Series II")
 
'do whatever....print reports

'Swtich back.
Set Application.Printer = Application.Printers(strDefaultPrinter)