'******************************************************************************************************************
'Procedure: SetReportDataSources
'Description: ' Crystal saves the Login Information and Location as part of the report. This procedure
' overrides the login information and location for all the report's DatabaseTables including any
' Subreports. It assumes all tables use the same login criteria (ie all data is from the same database).
' It also assumes that all reports are created from stored procedures(System standard).
' In order to override the Location we need to parse the DatabaseTable.Location property.
' This allows us to easily support several "environments" but we need to tell the Crystal engine
' which Login information to use and which stored procedure to use.
' For example - An application has three environments. Production, QA and Dev. The QA and Dev
' databases are called Pubs_Dev and Pubs_QA on server Handel. Bob, a developer, creates a report
' using the Pubs_Dev database and a stored procedure called selAuthorsbyState. Crystal will save the
' Location as pubs_dev.dbo.Proc(selAuthorsByState). When a user named TestUser runs an application,
' selects the QA environment at login and then tries to print the report - the data is retrieved from the
' Pubs_Dev database(even if we tell Crystal to login to the QA database).
' By changing the Location to selAuthorsByState(ie remove Pubs_Dev.dbo.Proc) we are assured the
' data is retrieved from the QA database tables.
'******************************************************************************************************************
Private Sub SetReportDataSources(CrystalReport As CRPEAuto.Report, ServerName As String, DatabaseName As String, UserName As String, Password As String)
On Error GoTo ErrorHandler
Dim lngStartPos As Long
Dim lngEndPos As Long
Dim objSubReport As CRPEAuto.Report
Dim objDB As CRPEAuto.Database
Dim objTables As CRPEAuto.DatabaseTables
Dim objTable As CRPEAuto.DatabaseTable
Dim objSections As CRPEAuto.Sections
Dim objSection As CRPEAuto.Section
Dim objReportObjects As CRPEAuto.ReportObjects
Dim objSubReports As CRPEAuto.SubreportObject
Dim lngIdx As Long
Set objDB = CrystalReport.Database
Set objTables = objDB.Tables
'set the login information
For Each objTable In objTables
lngStartPos = InStr(1, objTable.Location, "(", vbTextCompare) + 1
lngEndPos = InStr(lngStartPos, objTable.Location, ")", vbTextCompare)
If lngEndPos = 0 Then
lngEndPos = Len(objTable.Location) + 1
End If
lngEndPos = lngEndPos - lngStartPos
objTable.Location = Mid$(objTable.Location, lngStartPos, lngEndPos)
objTable.SetLogOnInfo ServerName, DatabaseName, UserName, Password
Next
'Access to the sub reports is through the Sections collection
Set objSections = CrystalReport.Sections
For Each objSection In objSections
Set objReportObjects = objSection.ReportObjects
If objReportObjects.Count > 0 Then
For lngIdx = 1 To objReportObjects.Count
'make sure the report object is a subreport.
If objReportObjects(lngIdx).Kind = crSubreportObject Then
'open the subreport and set the login information
Set objSubReports = objReportObjects(lngIdx)
Set objSubReport = CrystalReport.OpenSubreport(objSubReports.Name)
Set objDB = objSubReport.Database
Set objTables = objDB.Tables
For Each objTable In objTables
lngStartPos = InStr(1, objTable.Location, "(", vbTextCompare) + 1
lngEndPos = InStr(lngStartPos, objTable.Location, ")", vbTextCompare)
If lngEndPos = 0 Then
lngEndPos = Len(objTable.Location) + 1
End If
lngEndPos = lngEndPos - lngStartPos
objTable.Location = Mid$(objTable.Location, lngStartPos, lngEndPos)
objTable.SetLogOnInfo ServerName, DatabaseName, UserName, Password
Next
End If
Next
End If
Next
Exit Sub
ErrorHandler:
Err.Raise Err.Number, "SetReportDataSources", Err.Source, Err.Description
End Sub
