dcsimg
Results 1 to 2 of 2

Thread: Crystal Report Access with VB6

  1. #1

    Thread Starter
    New Member
    Join Date
    Jul 2010
    Posts
    3

    Crystal Report Access with VB6

    I am trying to call a Crystal Report (CR10) that has a subreport (the subreport connects to a different database than the main report) through my VB6 program. I usually don't have a problem calling reports with my code, but I've never done a report that has a subreport that connects to a different database (username and password is the same for the second database. The only thing different is the database name).

    I am using the code below (with the proper report and after changing the server, database name, password, etc to match mine), I still cannot get it to work.

    Any help is appreciated!

    Code:
    Dim Report As CRAXDRT.Report
    Dim SubReport As CRAXDRT.Report
    Dim App As CRAXDRT.Application
    Dim Sections As CRAXDRT.Sections
    Dim Section As CRAXDRT.Section
    Dim RepObjs As CRAXDRT.ReportObjects
    Dim SubReportObj As CRAXDRT.SubreportObject
    Dim n As Integer
    Dim i As Integer
    Dim j As Integer
    
      Set App = New CRAXDRT.Application
      Set Report = App.OpenReport("your.rpt")
    
      For n = 1 To Report.Database.Tables.Count
        Report.Database.Tables(n).SetLogOnInfo "server", "dbname", "user", "pass"
      Next n
    
      Set Sections = Report.Sections
      For n = 1 To Sections.Count
        Set Section = Sections.Item(n)
        Set RepObjs = Section.ReportObjects
        For i = 1 To RepObjs.Count
          If RepObjs.Item(i).Kind = crSubreportObject Then
             Set SubReportObj = RepObjs.Item(i)
             Set SubReport = SubReportObj.OpenSubreport
             For j = 1 To SubReport.Database.Tables.Count
                SubReport.Database.Tables(j).SetLogOnInfo "server", "db", "username", "pass"
             Next j
          End If
        Next i
      Next n

  2. #2
    Hyperactive Member
    Join Date
    Nov 2004
    Posts
    260

    Re: Crystal Report Access with VB6

    Hi i have solved it

    this is the code

    Code:
    Report = "\\MYPATH\Monthly_Sales_report_new.rpt"
        
        Set rep = appl.OpenReport(Report)
        
        
        
        
    '    rep.DiscardSavedData
        
        
    
    
    rep.ParameterFields.GetItemByName("@First_month_Start_date").AddCurrentValue CDate(txtFirstMonthStart.Text)
    rep.ParameterFields.GetItemByName("@First_month_End_date").AddCurrentValue CDate(txtFirstMonthEnd.Text)
    rep.ParameterFields.GetItemByName("@Second_month_Start_date").AddCurrentValue CDate(txtSecondMonthStart.Text)
    rep.ParameterFields.GetItemByName("@Second_month_End_date").AddCurrentValue CDate(txtSecondMonthEnd.Text)
    rep.ParameterFields.GetItemByName("@Year_Start_date").AddCurrentValue CDate(txtYearStart.Text)
    rep.ParameterFields.GetItemByName("@Year_End_date").AddCurrentValue CDate(txtYearEnd.Text)
    rep.ParameterFields.GetItemByName("@month_second_caption").AddCurrentValue CStr(txtSecondMonthCaption.Text)
    rep.ParameterFields.GetItemByName("@month_first_caption").AddCurrentValue CStr(txtFirstMonthCaption.Text)
    rep.ParameterFields.GetItemByName("@total_prev_caption").AddCurrentValue txtPrevTotalCaption.Text
    rep.ParameterFields.GetItemByName("@Total_current_caption").AddCurrentValue txtCurrentTotalCaption.Text
    rep.EnableParameterPrompting = False
    
    
    
    
    
    
    
    Dim eachtable As CRAXDRT.DatabaseTable
    For Each eachtable In rep.Database.Tables
        eachtable.ConnectionProperties("user id") = "user"
        eachtable.ConnectionProperties("password") = "Pass"
    
    Next
        
        
    
    Dim Sections As CRAXDRT.Sections
    Dim Section As CRAXDRT.Section
    Dim RepObjs As CRAXDRT.ReportObjects
    Dim SubReportObj As CRAXDRT.SubreportObject
    Dim SubReport As CRAXDRT.Report
    Dim n As Integer
    Dim i As Integer
    Dim j As Integer
    
     Set Sections = rep.Sections
      For n = 1 To Sections.Count
        Set Section = Sections.Item(n)
        Set RepObjs = Section.ReportObjects
        For i = 1 To RepObjs.Count
          If RepObjs.Item(i).Kind = crSubreportObject Then
             
             
             Set SubReportObj = RepObjs.Item(i)
             Set SubReport = SubReportObj.OpenSubreport
             If UCase(Trim(RepObjs.Item(i).Name)) = UCase(Trim("Subreport1")) Then
             
               
                'Set rep = appl.OpenReport(Report)
        
        
        
       SubReport.DiscardSavedData
        
        
    
    
    SubReport.ParameterFields.GetItemByName("@First_month_Start_date").AddCurrentValue CDate(frmAuto_Email.txtFirstMonthStart.Text)
    SubReport.ParameterFields.GetItemByName("@First_month_End_date").AddCurrentValue CDate(frmAuto_Email.txtFirstMonthEnd.Text)
    SubReport.ParameterFields.GetItemByName("@Second_month_Start_date").AddCurrentValue CDate(frmAuto_Email.txtSecondMonthStart.Text)
    SubReport.ParameterFields.GetItemByName("@Second_month_End_date").AddCurrentValue CDate(frmAuto_Email.txtSecondMonthEnd.Text)
    SubReport.ParameterFields.GetItemByName("@Year_Start_date").AddCurrentValue CDate(frmAuto_Email.txtYearStart.Text)
    SubReport.ParameterFields.GetItemByName("@Year_End_date").AddCurrentValue CDate(frmAuto_Email.txtYearEnd.Text)
    SubReport.ParameterFields.GetItemByName("@month_second_caption").AddCurrentValue CStr(frmAuto_Email.txtSecondMonthCaption.Text)
    SubReport.ParameterFields.GetItemByName("@month_first_caption").AddCurrentValue CStr(frmAuto_Email.txtFirstMonthCaption.Text)
    SubReport.ParameterFields.GetItemByName("@total_prev_caption").AddCurrentValue frmAuto_Email.txtPrevTotalCaption.Text
    SubReport.ParameterFields.GetItemByName("@Total_current_caption").AddCurrentValue frmAuto_Email.txtCurrentTotalCaption.Text
    
     
    SubReport.EnableParameterPrompting = False
    
    
             
             
             End If
             
             If UCase(Trim(RepObjs.Item(i).Name)) = UCase(Trim("Subreport2")) Then
             
               
                'Set rep = appl.OpenReport(Report)
        
        
        
       SubReport.DiscardSavedData
        
        
    
    
    SubReport.ParameterFields.GetItemByName("@First_month_Start_date").AddCurrentValue CDate(frmAuto_Email.txtFirstMonthStart.Text)
    SubReport.ParameterFields.GetItemByName("@First_month_End_date").AddCurrentValue CDate(frmAuto_Email.txtFirstMonthEnd.Text)
    SubReport.ParameterFields.GetItemByName("@Second_month_Start_date").AddCurrentValue CDate(frmAuto_Email.txtSecondMonthStart.Text)
    SubReport.ParameterFields.GetItemByName("@Second_month_End_date").AddCurrentValue CDate(frmAuto_Email.txtSecondMonthEnd.Text)
    SubReport.ParameterFields.GetItemByName("@Year_Start_date").AddCurrentValue CDate(frmAuto_Email.txtYearStart.Text)
    SubReport.ParameterFields.GetItemByName("@Year_End_date").AddCurrentValue CDate(frmAuto_Email.txtYearEnd.Text)
    SubReport.ParameterFields.GetItemByName("@month_second_caption").AddCurrentValue CStr(frmAuto_Email.txtSecondMonthCaption.Text)
    SubReport.ParameterFields.GetItemByName("@month_first_caption").AddCurrentValue CStr(frmAuto_Email.txtFirstMonthCaption.Text)
    SubReport.ParameterFields.GetItemByName("@total_prev_caption").AddCurrentValue frmAuto_Email.txtPrevTotalCaption.Text
    SubReport.ParameterFields.GetItemByName("@Total_current_caption").AddCurrentValue frmAuto_Email.txtCurrentTotalCaption.Text
    
     
    SubReport.EnableParameterPrompting = False
    
    
             
             
             End If
             
             
             
             For j = 1 To SubReport.Database.Tables.Count
                SubReport.Database.Tables(j).SetLogOnInfo "server", "DB", "User", "Password"
             Next j
             
          End If
        Next i
      Next n

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width