Attribute VB_Name = "Crystal"
'***********************************************************************
' Comments   : Sends the Main and the Notes ADO recordsets to the
'              Crystal Reports automation object and calls either
'              the preview or the print method as appropriate.
' Parameters :  rsMain - ADO Recordset (Main data recordset)
'               rsNotes - ADO Recordset (Order notes recordset)
'               bPreviewOnly - Boolean (Flag to indicate preview)
'               sReportFormat - String (Path to the report format)
' Returns    : nothing
' Created    : Enterprise Software Solutions [06/11/1999]
' Modified   :
'***********************************************************************
Public Sub SendToCrystal(rsMain As ADODB.Recordset, rsNotes As ADODB.Recordset, bPreviewOnly As Boolean, sReportFormat As String)
    On Error GoTo ErrorHandler
    
    Dim crpReport As CRPEAuto.Report  'Report object
    Dim crpDatabase As CRPEAuto.Database  'Database object
    Dim crpDatabaseTables As CRPEAuto.DatabaseTables  'Tables collection object
    Dim crpDatabaseTable As CRPEAuto.DatabaseTable 'Table object
    Dim crpSubReport As CRPEAuto.Report  'Report objects
    Dim crpSections As CRPEAuto.Sections  'Sections collection object
    Dim crpSection As CRPEAuto.Section  'Section object
    Dim crpReportObjects As CRPEAuto.ReportObjects  'Report objects collection
    Dim crpReportParm As CRPEAuto.ParameterFieldDefinition  'parms
    
    Dim iSection As Integer  'Section number
    Dim iReportObject As Integer  'Report object number
    
    'Instantiate the application object
    Set crpApplication = New CRPEAuto.Application
    
    'Set the report object to the appropriate report format
    Set crpReport = crpApplication.OpenReport(Trim(sReportFormat))

    'Set the database, database tables and database table to get
    'the SetPrivateData method to pass the ADO recordsets
    Set crpDatabase = crpReport.Database
    Set crpDatabaseTables = crpDatabase.Tables
    Set crpDatabaseTable = crpDatabaseTables.Item(1)
    
    'Pass the main ADO recordset to the database table of the report
    crpDatabaseTable.SetPrivateData 3, rsMain
    
    'Set the sections object
    Set crpSections = crpReport.Sections
    
    'loop through all parms
    For Each crpReportParm In crpReport.ParameterFields
        Select Case crpReportParm.Name
            Case "{?UserName}"
                'use BPCS login ID
                Call crpReportParm.SetCurrentValue(GetLoginName())
        End Select
    Next crpReportParm
    
    'Loop through all sections and report objects looking for a subreport (Order notes)
    For iSection = 1 To crpSections.Count
        Set crpSection = crpSections.Item(iSection)
        Set crpReportObjects = crpSection.ReportObjects
        For iReportObject = 1 To crpReportObjects.Count
            If crpReportObjects.Item(iReportObject).Kind = crSubreportObject Then
                Set crpSubReport = crpReport.OpenSubreport(crpReportObjects.Item(iReportObject).Name)
                Set crpDatabase = crpSubReport.Database
                Set crpDatabaseTables = crpDatabase.Tables
                Set crpDatabaseTable = crpDatabase.Tables.Item(1)
                'Set the order notes ADO recordset to the subreport
                crpDatabaseTable.SetPrivateData 3, rsNotes
            End If
        Next iReportObject
    Next iSection
    
    'If previewing, call the preview method, otherwise call the print method
    If bPreviewOnly = False Then
        crpReport.PrintOut False
    Else
        crpReport.Preview "Report - (Print Preview)"
    End If
    

ExitCleanup:
    On Error Resume Next
    Set crpReportParm = Nothing
    Set crpSubReport = Nothing
    Set crpSection = Nothing
    Set crpSections = Nothing
    Set crpReportObjects = Nothing
    Set crpDatabaseTable = Nothing
    Set crpDatabaseTables = Nothing
    Set crpDatabase = Nothing
    Set crpReport = Nothing
Exit Sub
ErrorHandler:
    RaiseSameError "SendToCrystal", "There was an error initiating the print or preview job (Error Code 13)"
    Resume ExitCleanup
'    Err.Raise vbObjectError + 100, "frmMain.SendToCrystal", _
        "There was an error initiating the print or preview job (Error Code 13):" & vbCr & vbCr & _
        "Number: " & Err.Number & vbCr & "Desc: " & Err.Description
End Sub