Option Explicit
Dim cn As New ADODB.Connection
Dim jro As New jro.JetEngine
Dim oRS As ADODB.Recordset
Dim oApp As CRAXDRT.Application
Dim oReport As CRAXDRT.report
Private Sub Form_Load()
Dim sSQL As String
CRViewer1.Top = 0
CRViewer1.Left = 0
CRViewer1.EnableExportButton = gstrRptExport
sSQL = gstrRptCmd
Me.Caption = gstrRptTitle
If Dir(gstrRptPath) = "" Then
MsgBox "Report file not found!", vbCritical
GoTo ReportErr
End If
If sSQL = "" Then
MsgBox "Invalid data retrieval!", vbCritical
Exit Sub
End If
On Error GoTo ReportErr
Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient
cn.Open gstrConnectString
Set oRS = New ADODB.Recordset
oRS.LockType = adLockReadOnly
oRS.CursorType = adOpenStatic
jro.RefreshCache cn
Set oRS = cn.Execute(sSQL, , adCmdText)
oRS.Requery
Set oApp = New CRAXDRT.Application
Set oReport = oApp.OpenReport(gstrRptPath, 1)
oReport.Database.SetDataSource oRS, 3, 1
oReport.PaperSize = oReport.PaperSize
oReport.PaperOrientation = oReport.PaperOrientation
On Error Resume Next
oReport.Sections("PH").ReportObjects("CompanyName").SetText gstrCompanyName
oReport.Sections("PH").ReportObjects("ReportTitle").SetText gstrRptTitle
oReport.Sections("PH").ReportObjects("ReportSubTitle").SetText gstrRptSubTitle
On Error GoTo 0
Screen.MousePointer = vbHourglass
CRViewer1.ReportSource = oReport
CRViewer1.ViewReport
Do While oReport.PrintingStatus.Progress = crPrintingInProgress
Loop
CRViewer1.Refresh
Screen.MousePointer = vbDefault
Exit Sub
ReportErr:
MsgBox Err.Description
Exit Sub
End Sub