Visual Basic 6 + Fastreport

Comments

• dm222

  September 2008 edited 12:54PM

  I'm not sure what yhour looking for so here is a copy from my vb
  
  Private Sub EnvelopeListing()
  Dim query_obj As TfrxADOQuery
  Dim database_obj As TfrxADODatabase
  Dim query_obj2 As TfrxADOQuery
  Dim database_obj2 As TfrxADODatabase
  Dim sql As String
  Dim sql2 As String
  Dim tOrder As String
  Dim wGender As String
  Dim wMem As String
  
  
  ' order by
  If GePortMain.optOrderBy4(0).value = True Then
  tOrder = " ORDER BY d.Envelope "
  Else
  tOrder = " ORDER BY d1.LastName "
  End If
  
  'Set families interval
  If (Trim(GePortMain.cmbFromFamily4.Text) = "All") Or (Trim(GePortMain.cmbFromFamily4.Text) = "") Then
  wFromFamily = "A"
  wUntilFamily = "ZZZZZZZZZZZZZZZZZZZZZZZZZ"
  Else
  wFromFamily = Trim(GePortMain.cmbFromFamily4.Text)
  If (GePortMain.chkUntilFamily4.value = Checked) Then
  If (Trim(GePortMain.cmbUntilFamily4.Text) = "") Then
  wUntilFamily = wFromFamily
  Else
  wUntilFamily = Trim(GePortMain.cmbUntilFamily4.Text)
  End If
  Else
  wUntilFamily = wFromFamily
  End If
  End If
  
  'Set members gender
  If (GePortMain.optGender4(0).value = True) Then
  wGender = "M"
  Else
  If (GePortMain.optGender4(1).value = True) Then
  wGender = "F"
  Else
  wGender = ""
  End If
  End If
  
  
  ' envelopes
  If (Trim(GePortMain.txtStartEnvelope4.Text) = "000000") Or (Trim(GePortMain.txtStartEnvelope4.Text) = "") Then
  wStartEnvelope = " "
  wEndEnvelope = " "
  Else
  wStartEnvelope = " AND d.Envelope >= '" & Trim(GePortMain.txtStartEnvelope4.Text) & "'"
  wEndEnvelope = " AND d.Envelope <= '" & Trim(GePortMain.txtEndEnvelope4.Text) & "'"
  End If
  
  
  
  ' sql and report
  'Assemble the SQL string
  theSQL = ("SELECT d.*, d1.* " & _
  "From " & _
  "dbo.MEMBERS d " & _
  "INNER JOIN dbo.FAMILIES d1 ON (d.FamilyIdFK=d1.FamilyId) " & _
  "where d.gender like '%" & wGender & "%' and d.Died <> 'Y' AND d.died IS NOT NULL " & _
  "AND d1.LastName >= '" & wFromFamily & "' AND d1.LastName <= '" & wUntilFamily & "' " & _
  "AND d.Archived <> 'Y' " & _
  wStartEnvelope & wEndEnvelope & tOrder)
  
  Set rs = New ADODB.Recordset
  Set rs = Conn.Execute("SELECT d.*, d1.* " & _
  "From " & _
  "dbo.MEMBERS d " & _
  "INNER JOIN dbo.FAMILIES d1 ON (d.FamilyIdFK=d1.FamilyId) " & _
  "where d.gender like '%" & wGender & "%' and d.Died <> 'Y' AND d.died IS NOT NULL " & _
  "AND d1.LastName >= '" & wFromFamily & "' AND d1.LastName <= '" & wUntilFamily & "' " & _
  "AND d.Archived <> 'Y' " & _
  wStartEnvelope & wEndEnvelope & tOrder)
  If rs.EOF Then
  Answer = CoolBox("The report you are trying to produce is blank. Please redefine the report filters.", vbOKOnly)
  Exit Sub
  End If
  
  
  
  
  If GePortMain.optStyle4(0).value = True Then
  frx.LoadReportFromFile (App.Path & "\GePort Reports\Envelope Listing 1.fr3")
  End If
  
  
  
  
  
  
  
  
  
  
  
  ' Find database object
  Set database_obj = frx.FindObject("ADODatabase1")
  If database_obj Is Nothing Then
  MsgBox "ADO connection object 'ADODatabase1' not found"
  Else
  database_obj.Connected = False
  database_obj.ConnectionString = Conn.ConnectionString
  ' You can set connection string insted of showing it.
  End If
  ' Find database object 2 - common to get church data
  Set database_obj2 = frx.FindObject("ADODatabase2")
  If database_obj2 Is Nothing Then
  MsgBox "ADO connection object 'ADODatabase2' not found"
  Else
  database_obj2.Connected = False
  database_obj2.ConnectionString = Conn2.ConnectionString
  ' You can set connection string insted of showing it.
  End If
  
  ' ' Find query object
  Set query_obj = frx.FindObject("MemberInfo")
  '
  If query_obj Is Nothing Then
  MsgBox "ADO query object 'MemberInfo' not found"
  Else
  Rem MsgBox "Current query: " + Trim$(query_obj.query)
  query_obj.Query = theSQL
  End If
  sql2 = "Select * from Churches where ChurchID = '" & UserConfig.DefaultChurch & "'"
  ' ' Find query object
  Set query_obj2 = frx.FindObject("ChurchInfo")
  '
  If query_obj2 Is Nothing Then
  MsgBox "ADO query object 'ChurchInfo Query' not found"
  Else
  Rem MsgBox "Current query: " + Trim$(query_obj.query)
  query_obj2.Query = sql2
  End If
  
  frx.ShowReport
  
  
  
  End Sub