Public Sub Print_List(pReport As String, pStatus As Integer, pExportIt As Boolean)
'// Prints a report listing the Tenants used by the program.
'// Parameters: pReport - the name of the report to be used.
'// pExportIt - determines whether the report is to be exported to a file.
Dim l_bolError As Boolean
Dim rsActive As ADODB.Recordset
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim frmTL As Form
Dim prn As Printer '// For selecting a Printer.
On Error GoTo ERR_Handler
'// The following creates the Application object (which is the Crystal
'// Automation Server) and assigns it to CrystalApplication.
'// Creating this object must be done for each application
'// that uses the Crystal Automation Server.
'// If this is to be related to using the ActiveX or OCX control, this following
'// method would be thought of as simply placing the control onto the VB form.
Set CR_Application = New CRAXDDRT.Application
'// The following sets the database location for all tables that are used in the report
Set CR_Report = CR_Application.OpenReport(pReport, 1)
Set CR_Db = CR_Report.Database
Set CR_DbTables = CR_Db.Tables
Set CR_DbTable = CR_DbTables.Item(1)
'// Create the active data recordset to be passed to the report.
Set rsActive = New ADODB.Recordset
With rsActive
.Fields.Append "Company Name", adVarChar, 120
.Fields.Append "Company Address1", adVarChar, 120
.Fields.Append "Company City", adVarChar, 120
.Fields.Append "Company State", adVarChar, 120
.Fields.Append "Company Postal", adVarChar, 120
.Open '// Open the recordset
End With
'// Get the basic report information.
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = rptCONN
.CommandType = adCmdStoredProc
.CommandText = "rptList"
.Parameters.Append .CreateParameter("Status", adInteger, adParamInput)
.Parameters("Status").Value = pStatus
End With
rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
If Not (rs.BOF And rs.EOF) Then
Do Until rs.EOF
With rsActive
.AddNew
.Fields("Company Name").Value = rptSESS.Company.Name
.Fields("Company Address1").Value = rptSESS.Company.Address1
.Fields("Company City").Value = rptSESS.Company.City
.Fields("Company State").Value = rptSESS.Company.State
.Fields("Company Postal").Value = rptSESS.Company.PostCode
.Update
End With
rs.MoveNext
Loop
Else
MsgBox "Report Error"
l_bolError = True
End If
If Not l_bolError Then
'// With the recordset object populated with data,
'we will direct the MAIN report to
'// use this data as it's datasource.
CR_DbTable.SetDataSource rsActive, 3
Export_Report "Tenant List"
End If
'// Clean up the data and the active recordset.
rs.Close
Set rs = Nothing
rsActive.Close
Set rsActive = Nothing
Exit Sub
ERR_Handler:
Select Case Err.Number
Case 94, 9 '// Invalid use of null, Subscript out of range.
Resume Next
Case Else
PrintError Err.Number, Err.Description, "modPrint.Print_List"
End Select
End Sub
Private Function Export_Report(pName As String) As Boolean
'// Email the report to the selected format.
'// Parameters: pName - part of the file name to be created by the export.
'// Returns: Boolean - whether the export was successful.
On Error GoTo ERR_Handler
g_bolExportSuccess = False
CR_Report.DisplayProgressDialog = True
'// Excel.
CR_Report.ExportOptions.FormatType = crEFTExcel97
CR_Report.ExportOptions.DestinationType = crEDTDiskFile
CR_Report.ExportOptions.DiskFileName = "C:\somefolder\somefilename" & ".xls"
CR_Report.Export False
CR_Report.ReadRecords
g_strAttach = CR_Report.ExportOptions.DiskFileName
g_bolExportSuccess = True
Exit Function
ERR_Handler:
ErrorMessenger Err.Number, Err.Description, "modPrint.Export_Report"
End Function
