Hello,
My manager is all over me because of this issue ... please can some help me
I am working on an VB6 application which use Crystal Report 8.0.1.0 for reports and the backend database is SQL Server 2005.
My report uses stored procedure to get the records from database. The Stored Procedure access multiple database to get the records.
I am having trouble with few Crystal Reports which I am calling from VB6. The report is the cumulative report and the issue is that the crystal Report is not returning any data.
I am passing 2 parameter to the report:
1. DATE passed as varchar
2. VARCHAR
Reference in Code
1. Crystal Viewer Control (cviewer.oca)
2. Crystal ActiveX Report Viewer Library 11.0
3. Crystal Reports ActiveX Designer Run Time Library 11.0
Components used in Code
1. Crystal ActiveX Report Viewer Library 11.0 (crviewer.dll)
2. Crystal Report Control (Crystl32.OCX)
Here is the code I am using
Option Explicit
Dim crApp As New CRAXDRT.Application
Dim crRep As CRAXDRT.Report
Dim crParamDefs As CRAXDRT.ParameterFieldDefinitions
Dim crParamDef As CRAXDRT.ParameterFieldDefinition
Dim crDBTab As CRAXDRT.DatabaseTable
Dim HasExportOptionShown As Boolean
Dim HasReportPrinted As Boolean
Dim strDefaultPrinter As String, defaultindex As Byte
Dim ValueName As String
Dim rs As New ADODB.Recordset
Dim rsItem As New ADODB.Recordset
Dim DriverName, PrinterName, Port As String
Dim DontPrint As Boolean
Dim today As Date
Private Sub Form_Load()
today = DateWithCentury(Date)
End Sub
Private Sub Command1_Click()
'''''rpt2 is Crystal Report Control on the form (Crystl32.OCX)
rpt2.PrintFileType = crptExcel50
rpt2.Destination = crptToFile
rpt2.ProgressDialog = False
rpt2.WindowState = crptMinimized
rpt2.DiscardSavedData = True
Dim filesys,demofile
Dim foldername As String
Dim fso As New FileSystemObject
'variables for date range and work formula
Dim WorkFormula, mBeginDate, mEndDate
mBeginDate = Format(CStr(Month(today)) + "/" + "1/" + CStr(Year(today)), "YYYY/MM/DD")
If CDate(today) = CDate("1/30/08") Or CDate(today) = CDate("1/31/08") Then
mBeginDate = "12/30/2007"
End If
mBeginDate = Format(mBeginDate, "YYYY/MM/DD")
mEndDate = Format(today, "YYYY/MM/DD")
WorkFormula = "{sometable.somedatefield}>=#" & CDate(mBeginDate) & " 00:00:00# AND "
WorkFormula = WorkFormula & " {sometable.somedatefield}<=#" & CDate(mEndDate) & " 23:59:59#"
Set filesys = CreateObject("Scripting.FileSystemObject")
foldername = CStr(Format(today, "mm_dd_YY"))
If fso.FolderExists("C:\FOLDER\" & foldername & "\") = False Then
fso.CreateFolder "C:\FOLDER\" & foldername & "\"
End If
rpt2.ReportFileName = "C:\FOLDER\Reports\Report.rpt"
rpt2.PrintFileName = "C:\FOLDER\" & foldername & "\Report.xls"
rpt2.DiscardSavedData = True
rpt2.ReportTitle = "From: " & mBeginDate & " To: " & mEndDate
rpt2.StoredProcParam(0) = mBeginDate
rpt2.StoredProcParam(1) = "SOMEPARAM"
LoadReport rpt2.ReportFileName, rpt2.PrintFileName, 2
End Sub
Private Sub LoadReport(ByVal reportname As String, ByVal ExcelName As String, ByVal Method As Integer)
Dim crSections As CRAXDRT.Sections
Dim crSection As CRAXDRT.Section
Dim crRepObjs As CRAXDRT.ReportObjects
Dim crSubRepObj As CRAXDRT.SubreportObject
Dim crSubReport As CRAXDRT.Report
Dim j As Integer, k As Integer
Dim i As Integer
Dim ConnectionInfo As CRAXDRT.ConnectionProperties
Dim ServerName As String
ServerName = "MYDBSERVERNAME"
Set crRep = crApp.OpenReport(reportname, 0)
'If crRep.Database.Tables(1).DllName = "crdb_ado.dll" And InStr(reportname, "SOMEREPORT") <= 0 Then
' Set ConnectionInfo = crRep.Database.Tables(1).ConnectionProperties
' crRep.Database.Tables(1).DllName = "crdb_odbc.dll"
' ConnectionInfo.DeleteAll
' ConnectionInfo.Add "DSN", ServerName
' ConnectionInfo.Add "User ID", "xxxxx"
' ConnectionInfo.Add "Password", "xxxxx"
'ElseIf crRep.Database.Tables(1).DllName = "crdb_odbc.dll" Then
'Else
crRep.Database.LogOnServer "p2ssql.dll", ServerName, "MYDBNAME", "xxxx", "xxxx"
For Each crDBTab In crRep.Database.Tables
crDBTab.SetLogOnInfo ServerName, "MYDBNAME", "xxxx", "xxxx"
Next
'End If
crRep.EnableParameterPrompting = False
With rpt2
If .DiscardSavedData = True Then
crRep.DiscardSavedData
End If
For i = 1 To crRep.ParameterFields.Count
crRep.ParameterFields.Item(i).ClearCurrentValueAndRange
crRep.ParameterFields.Item(i).AddCurrentValue .StoredProcParam(i - 1)
DoEvents
Next
Set crSections = crRep.Sections
For i = 1 To crSections.Count
Set crSection = crSections.Item(i)
Set crRepObjs = crSection.ReportObjects
For j = 1 To crRepObjs.Count
If crRepObjs.Item(j).Kind = crSubreportObject Then
Set crSubReport = crRep.OpenSubreport(crRepObjs.Item(j).SubreportName)
For k = 1 To crSubReport.ParameterFields.Count
crSubReport.ParameterFields(k).ClearCurrentValueAndRange
crSubReport.ParameterFields(k).AddCurrentValue .StoredProcParam(k - 1)
Next
End If
Next
Next
crRep.ReportTitle = .ReportTitle
rpt.ReportSource = crRep
crRep.FormulaSyntax = crCrystalSyntaxFormula '
If .SelectionFormula <> "" Then
If crRep.RecordSelectionFormula = "" Then
crRep.RecordSelectionFormula = .SelectionFormula
Else
crRep.RecordSelectionFormula = crRep.RecordSelectionFormula & " AND " & .SelectionFormula
End If
End If
End With
rpt2.Destination = Method
Select Case rpt2.Destination
Case 1 'Printer
Me.WindowState = vbMinimized
rpt.ViewReport
DoEvents
crRep.PrintOut False
Case 0 'Screen
Me.WindowState = vbMaximized
rpt.EnableDrillDown = rpt2.WindowAllowDrillDown
rpt.EnableExportButton = True
rpt.EnableGroupTree = False
rpt.EnableRefreshButton = True
rpt.EnablePrintButton = True
rpt.EnableSelectExpertButton = True
rpt.Zoom (100)
rpt.ViewReport
Case 2 'Excel
Me.WindowState = vbMinimized
rpt.ViewReport
DoEvents
HasExportOptionShown = False
Export (ExcelName)
End Select
End Sub
Private Sub Export(ByVal ExcelName As String)
If Not HasExportOptionShown Then
HasExportOptionShown = True
Else
Exit Sub
End If
With crRep.ExportOptions
.ExcelTabHasColumnHeadings = True
.FormatType = crEFTExcel50
.DestinationType = crEDTDiskFile
.DiskFileName = ExcelName
End With
crRep.Export False
End Sub
Private Sub PrintOut()
If Not HasReportPrinted Then
HasReportPrinted = True
Else
Exit Sub
End If
End Sub
Thank you everyone for answer in advance