how to code to display simultaneous crystal report in vb6 ?

[niravpatwa]

I have write this code :


Dim strSqlValid
Dim objConn1 As ADODB.Connection
Dim objRS1 As ADODB.Recordset
Dim objRS2 As ADODB.Recordset
Dim objRSItem As ADODB.Recordset
Dim formula As String
Dim Appl As New CRAXDRT.Application
Dim rptReport As New CRAXDRT.Report
Dim sReportName As String
Dim gstrDatabaseName As String
Dim gstrUserName As String
Dim gstrPassword As String
Dim comp As String
Dim i As Integer
Dim k As Integer
Dim strTemp As String
Dim strSplit() As String


Private Sub Form_Load()

' common code start

comp = "500"
gstrDatabaseName = "baantest"
gstrUserName = "web"
gstrPassword = "web123"

' set screen
CR1.Top = 10
CR1.Left = 0
CR1.Height = Screen.Height - 1000
CR1.Width = Screen.Width
Screen.MousePointer = vbHourglass

Set objConn1 = CreateObject("ADODB.Connection")
Set objRS1 = CreateObject("ADODB.Recordset")
Set objRS2 = CreateObject("ADODB.Recordset")
Set objRSItem = CreateObject("ADODB.Recordset")

objConn1.Open "Provider=MSDASQL.1;Persist Security Info=False;Data Source=baantest", "web", "web123"

' get value from the main form
strSplit = Split(frmInventoryTransactions.lblQMSProject.Capti on, " ")
lblQMSProject.Caption = strSplit(0)
lblSeam.Caption = frmInventoryTransactions.lblSeam.Caption
lblItem.Caption = Mid$(frmInventoryTransactions.lblItem.Caption, 1, 16)

'common code end

' getting 10th character of the item code which defines the welding process.
strTemp = Mid$(lblItem.Caption, 10, 1)
'MsgBox (strTemp)

' for SMAW
If (strTemp = "E" Or strTemp = "e") Then
sReportName = "SMAW.rpt"

strSqlValid = "SELECT * FROM ttiitm001500"
strSqlValid = strSqlValid & " WHERE t_item = '" & lblItem.Caption & "'"
Set objRSItem = objConn1.Execute(strSqlValid)

Appl.LogOnServer "pdsodbc.dll", gstrDatabaseName, "", gstrUserName, gstrPassword
Set rptReport = Appl.OpenReport(App.Path & "\" & sReportName)
rptReport.DiscardSavedData
For i = 1 To rptReport.Database.Tables.Count
'MsgBox (rptReport.Database.Tables(1).Name)
rptReport.Database.LogOnServer "pdsodbc.dll", gstrDatabaseName, "", gstrUserName, gstrPassword
Next i

If (objRSItem.BOF And objRSItem.EOF) Then
Else
objRSItem.MoveFirst

strSqlValid = "SELECT * FROM tltwps021500"
strSqlValid = strSqlValid & " WHERE t_cprj ='" & lblQMSProject.Caption & "'"
strSqlValid = strSqlValid & " and t_seam = '" & lblSeam.Caption & "' "
strSqlValid = strSqlValid & " and (t_con1 = '" & Trim(objRSItem.Fields("t_seab").Value) & "' "
strSqlValid = strSqlValid & " or t_con2 = '" & Trim(objRSItem.Fields("t_seab").Value) & "' "
strSqlValid = strSqlValid & " or t_con3 = '" & Trim(objRSItem.Fields("t_seab").Value) & "' "
strSqlValid = strSqlValid & " or t_con4 = '" & Trim(objRSItem.Fields("t_seab").Value) & "') "
Set objRS1 = objConn1.Execute(strSqlValid)

objRS1.MoveFirst

'k = 0

Do While (objRS1.BOF <> True And objRS1.EOF <> True)

'MsgBox (objRS1.Fields("t_wpsn").Value)

formula = "{tltwps021500.t_cprj} = '" & lblQMSProject.Caption & "' and {tltwps021500.t_wpsn} = '" & Trim(objRS1.Fields("t_wpsn").Value) & "' and {tltwps021500.t_seam} = '" & lblSeam.Caption & "' and ({tltwps021500.t_con1} = '" & Trim(objRS1.Fields("t_con1").Value) & "' or {tltwps021500.t_con2} = '" & Trim(objRS1.Fields("t_con2").Value) & "' or {tltwps021500.t_con3} = '" & Trim(objRS1.Fields("t_con3").Value) & "' or {tltwps021500.t_con4} = '" & Trim(objRS1.Fields("t_con4").Value) & "') "
'rptReport.FormulaFields(1).Text = """Testing Name"""
rptReport.RecordSelectionFormula = formula

'ReDim Preserve rptReport(0 To k) As New CRAXDRT.Report

If Trim(UCase(objRS1.Fields("t_con1").Value)) = Trim(UCase(objRSItem.Fields("t_seab").Value)) Then
rptReport.FormulaFields(1).Text = "'" & objRS1.Fields("t_lsq1").Value & "'"
rptReport.FormulaFields(2).Text = "'" & objRS1.Fields("t_con1").Value & "'"
rptReport.FormulaFields(3).Text = "'" & objRS1.Fields("t_brnd").Value & "'"
rptReport.FormulaFields(4).Text = "'" & objRS1.Fields("t_ffno1").Value & "'"
rptReport.FormulaFields(5).Text = "'" & objRS1.Fields("t_siz1").Value & "'"
rptReport.FormulaFields(6).Text = "'" & objRS1.Fields("t_cur1").Value & "'"
rptReport.FormulaFields(7).Text = "'" & objRS1.Fields("t_vlt1").Value & "'"
rptReport.FormulaFields(8).Text = "'" & objRS1.Fields("t_pltp1").Value & "'"
rptReport.FormulaFields(9).Text = "'" & objRS1.Fields("t_bln1").Value & "'"
rptReport.FormulaFields(10).Text = "'" & objRS1.Fields("t_tsp1").Value & "'"
ElseIf Trim(UCase(objRS1.Fields("t_con2").Value)) = Trim(UCase(objRSItem.Fields("t_seab").Value)) Then
rptReport.FormulaFields(1).Text = "'" & objRS1.Fields("t_lsq2").Value & "'"
rptReport.FormulaFields(2).Text = "'" & objRS1.Fields("t_con2").Value & "'"
rptReport.FormulaFields(3).Text = "'" & objRS1.Fields("t_brn2").Value & "'"
rptReport.FormulaFields(4).Text = "'" & objRS1.Fields("t_ffno2").Value & "'"
rptReport.FormulaFields(5).Text = "'" & objRS1.Fields("t_siz2").Value & "'"
rptReport.FormulaFields(6).Text = "'" & objRS1.Fields("t_cur2").Value & "'"
rptReport.FormulaFields(7).Text = "'" & objRS1.Fields("t_vlt2").Value & "'"
rptReport.FormulaFields(8).Text = "'" & objRS1.Fields("t_pltp2").Value & "'"
rptReport.FormulaFields(9).Text = "'" & objRS1.Fields("t_bln1").Value & "'"
rptReport.FormulaFields(10).Text = "'" & objRS1.Fields("t_tsp2").Value & "'"
ElseIf Trim(UCase(objRS1.Fields("t_con3").Value)) = Trim(UCase(objRSItem.Fields("t_seab").Value)) Then
rptReport.FormulaFields(1).Text = "'" & objRS1.Fields("t_lsq3").Value & "'"
rptReport.FormulaFields(2).Text = "'" & objRS1.Fields("t_con3").Value & "'"
rptReport.FormulaFields(3).Text = "'" & objRS1.Fields("t_brn3").Value & "'"
rptReport.FormulaFields(4).Text = "'" & objRS1.Fields("t_ffno3").Value & "'"
rptReport.FormulaFields(5).Text = "'" & objRS1.Fields("t_siz3").Value & "'"
rptReport.FormulaFields(6).Text = "'" & objRS1.Fields("t_cur3").Value & "'"
rptReport.FormulaFields(7).Text = "'" & objRS1.Fields("t_vlt3").Value & "'"
rptReport.FormulaFields(8).Text = "'" & objRS1.Fields("t_pltp3").Value & "'"
rptReport.FormulaFields(9).Text = "'" & objRS1.Fields("t_bln3").Value & "'"
rptReport.FormulaFields(10).Text = "'" & objRS1.Fields("t_tsp3").Value & "'"
ElseIf Trim(UCase(objRS1.Fields("t_con4").Value)) = Trim(UCase(objRSItem.Fields("t_seab").Value)) Then
rptReport.FormulaFields(1).Text = "'" & objRS1.Fields("t_lsq4").Value & "'"
rptReport.FormulaFields(2).Text = "'" & objRS1.Fields("t_con4").Value & "'"
rptReport.FormulaFields(3).Text = "'" & objRS1.Fields("t_brn4").Value & "'"
rptReport.FormulaFields(4).Text = "'" & objRS1.Fields("t_ffno4").Value & "'"
rptReport.FormulaFields(5).Text = "'" & objRS1.Fields("t_siz4").Value & "'"
rptReport.FormulaFields(6).Text = "'" & objRS1.Fields("t_cur4").Value & "'"
rptReport.FormulaFields(7).Text = "'" & objRS1.Fields("t_vlt4").Value & "'"
rptReport.FormulaFields(8).Text = "'" & objRS1.Fields("t_pltp4").Value & "'"
rptReport.FormulaFields(9).Text = "'" & objRS1.Fields("t_bln4").Value & "'"
rptReport.FormulaFields(10).Text = "'" & objRS1.Fields("t_tsp4").Value & "'"
End If
Set objRS2 = CreateObject("ADODB.Recordset")
strSqlValid = "SELECT * from ttclnt055500"
strSqlValid = strSqlValid & " WHERE t_cprj ='" & lblQMSProject.Caption & "'"
strSqlValid = strSqlValid & " and t_seam = '" & lblSeam.Caption & "'"
strSqlValid = strSqlValid & " and (t_wpsn = '" & lblWpsn.Caption & "'"
strSqlValid = strSqlValid & " or t_wpsa = '" & lblWpsn.Caption & "'"
strSqlValid = strSqlValid & " or t_wpsb = '" & lblWpsn.Caption & "')"
Set objRS2 = objConn1.Execute(strSqlValid)
If (objRS2.BOF And objRS2.EOF) Then
Else
objRS2.MoveFirst
rptReport.FormulaFields(11).Text = "'" & objRS2.Fields("t_nots").Value & "'"
End If

'CR1.Refresh
'Exit Sub
'Set rptReport = Nothing
objRS1.MoveNext
Loop
End If
End If

' common code start
objConn1.Close
Set objConn1 = Nothing
CR1.ReportSource = rptReport
CR1.ViewReport
Screen.MousePointer = vbDefault
' common code end

End Sub



the query " select * from tltwps021500...." gets 2 records.

The problem is that it shows me only one report of last
record. It doesn't show me the two reports of two records.

I have also attach text file of the above code..

if anyone find solution of this code pls reply as early as possible.

and thanks in advance...