Posted 4 August 2017, 6:11 am EST
I have attached the code that is executed when the report starts. There is no report interaction after that. What we see is the report tools along a record is partially invalid–gets the next records data then runs ok until the next random error.
There are two chucks of code here> The first is used to get the rpx file and add in the connection string which we remove from the report. The second is a class used to populate the sub-reports with the correct connection information. The only scripting is in the rpx I sent you and is used for the run dat of the report.
Public Sub OpenCustomReport()
Dim arDataControl As DataControl
Dim objLink As New clsSubRptLink
Dim intLoadError As Integer
With frmContractMain.CommonDialog1
.FileName = vbNullString
.Filter = “Custom Report Files (.RPX)|.rpx”
On Error GoTo ERRORCON
.ShowOpen
On Error GoTo 0
If .FileName <> vbNullString Then
Set garCustomReport = New DDActiveReports2.ActiveReport
garCustomReport.LoadLayout (.FileName)
'Link all Subreports for Main Report. NOTE: code to resolve sub reports must be here to work
garCustomReport = objLink.StaticSubLink(garCustomReport, gstrSQLProvider, caFileServices.ParsePath(.FileName, parDrvDir), intLoadError)
If intLoadError = 2 Then
Exit Sub
End If
Set arDataControl = garCustomReport.Sections(“Detail”).Controls(“dc”)
If InStr(1, arDataControl.ConnectionString, gcstSecureAccess) Then
arDataControl.ConnectionString = gstrSQLProvider
ElseIf InStr(1, arDataControl.ConnectionString, gcstDbProvider) Then
arDataControl.ConnectionString = gcstDbProvider & gstrInitialAppPath & gcstReportDbName
Else
MsgBox MSG01, vbApplicationModal + vbExclamation + vbOKOnly, “Open Custom Report”
Unload frmCustomReportViewer
Exit Sub
End If
End If
If .FileName <> vbNullString Then
Unload frmCustomReportViewer
frmCustomReportViewer.Show
End If
End With
Exit Sub
ERRORCON:
If ERR <> cdlCancel Then
MsgBox ERR.Description
End If
End Sub
Option Explicit
Const cstRepStr = “”
Const cstRepPath = “”
Const MSG01 = "Warning! Could not find a data control on the subreport " & cstRepStr & ". This may or may not be a problem although an ADO control would normally be present. Processing will continue. "
Const MSG02 = "The sub-report " & gcstQuote & cstRepStr & gcstQuote & " could not be located in file path " & gcstQuote & cstRepPath & gcstQuote & “. Request has been cancelled. Check to be certain that the missing sub-report is located in the designated path.”
Const MSG03 = “Load sub-report”
Public Function StaticSubLink(objReport As Object, _
ByVal strConnection As String, _
ByVal strSubRptPath As String, _
intErrorLvl As Integer, _
Optional bolReprotError As Boolean = True) As Object
Dim rptSet As Object
Dim objCtl As Object
Dim objCtl2 As Object
Dim ardcDataControl As DataControl
'This loop process every rptSettion looking for any subreport controls
'Once it Finds a Subreport Control it loads the RPX File that is stored in the SubreportControl.ReportName
'After the Subreport object is loaded it sets SubreportControl.Object to the Subreport Instance
intErrorLvl = 0
For Each rptSet In objReport.Sections
For Each objCtl In rptSet.Controls
If TypeName(objCtl) = “SubReport” Then
If objCtl.ReportName <> vbNullString Then
Set objCtl.object = New ActiveReport
'Set objCtl.object = New DDActiveReports2.ActiveReport
On Error GoTo LOADFAILED
objCtl.object.LoadLayout strSubRptPath & objCtl.ReportName
On Error GoTo 0
End If
On Error Resume Next
ERR.Clear
'Populate the subreport with the same connection sting as used in the main report
'If the ConnectionString missing can cause a fso.delete delete to later on throw a malicious script error
Set objCtl2 = objCtl.object.Sections(“Detail”).Controls(“dc”)
If ERR.Number = 0 Then 'If no control issue warning but continue. Sub report may be static information
Set ardcDataControl = objCtl2
ardcDataControl.ConnectionString = strConnection
Else
intErrorLvl = 1
If bolReprotError Then
MsgBox Replace(MSG01, cstRepStr, objCtl.ReportName), vbInformation + vbApplicationModal + vbOKOnly, MSG03
End If
End If
On Error GoTo 0
End If
Next
Next
'Return the new report object
Set StaticSubLink = objReport
Exit Function
LOADFAILED:
intErrorLvl = 2
If bolReprotError Then
MsgBox Replace(Replace(MSG02, cstRepPath, strSubRptPath), cstRepStr, objCtl.ReportName), vbApplicationModal + vbExclamation + vbOKOnly, MSG03
End If
Set StaticSubLink = objReport 'Doing this avoids an error
End Function
