zambi 0 Newbie Poster

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

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.