Crystal Report Access with VB6

參考引用
--
引用1:
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:
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