G
Guest
OK why does the following code work in a Windows form with a crystal report
viewer but not in a webform. I get the usual
CrystalReports.EngineLogONException logon Failed when this is called in aspx.
Any help will be very much apprecaited
Alixx
This is the code in the calling aspx Page
Imports CrystalDecisions.CrystalReports
Imports CrystalDecisions.ReportSource
Imports CrystalDecisions.Shared
Imports CrystalDecisions.Web
Imports CrystalDecisions.Windows.Forms
Imports CrystalDecisions.CrystalReports.Engine
Public Class Order
Inherits System.Web.UI.Page
#Region " Web Form Designer Generated Code "
'This call is required by the Web Form Designer.
Protected WithEvents WebViewer As CrystalDecisions.Web.CrystalReportViewer
Protected WithEvents PrintReport As System.Web.UI.WebControls.ImageButton
Protected WithEvents Label1 As System.Web.UI.WebControls.Label
<System.Diagnostics.DebuggerStepThrough()> Private Sub
InitializeComponent()
End Sub
'NOTE: The following placeholder declaration is required by the Web Form
Designer.
'Do not delete or move it.
Private designerPlaceholderDeclaration As System.Object
Private Sub Page_Init(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles MyBase.Init
'CODEGEN: This method call is required by the Web Form Designer
'Do not modify it using the code editor.
InitializeComponent()
End Sub
#End Region
Private Sub Page_Load(ByVal sender As Object, ByVal e As
System.EventArgs) Handles MyBase.Load
Dim DoReport As New Order_Class
DoReport.SetCompany = "BK"
DoReport.SetEmail = "(e-mail address removed)"
DoReport.SetOrderNumber = "223"
Dim szResponse As String = DoReport.CreateOrder()
Dim MyReport As ReportDocument
MyReport = DoReport.EmailPDF
Me.WebViewer.ReportSource = MyReport
End Sub
End Class
Ok this is the start of the code for the class that I call the main
function is emailPDFwhich calls ChangeLogOnInfo EmailPDF returns a Report
Document which so that it can be viewed; eventually it will be exported as
PDF as well(note I have tried just exporting it but doesnt seem to work).
#Region "Imports_Declared"
Imports System.Data.SqlClient
Imports System.Data.SqlClient.SqlCommand
Imports System.Data.SqlClient.SqlConnection
Imports System.IO.BinaryWriter
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared
Imports CrystalDecisions.ReportSource
Imports CrystalDecisions.Web
Imports CrystalDecisions.Windows.Forms
Imports System.Web
Imports System.Web.Mail
Imports System.Diagnostics
Imports Microsoft.Win32
Imports System.Runtime.InteropServices
Imports System.Security.Principal
#End Region
#Region "Boiler_Plate"
'########################################################################
'# Web Order Class Version 2.0 #
'# Created By Alixx Skevington #
'# #
'# This will create the XML dcoument that is needed for Khaos #
'# That will eventually automatically imported into the database #
'# Then Automatically email's the customer and the shop #
'# And also displays a copy of the report to have it printed #
'# Revision History None #
'########################################################################
#End Region
Public Class Order_Class
Public Enum CompanyInfo
AGS
BK
OTHER
End Enum
#Region "Global Variables Declared"
Dim szErrorMailPrimary As String ' This is where all the mail messages
will go
Dim szErrorMailSecondary As String 'This is where all the mail messages
will go to make sure soembody gets them
Dim szMailServer As String 'this is the address of the mail server
Dim szMailFrom As String 'this is who the mail is from
Dim szPathToPDF As String
Dim szPathToExport As String
Dim szKhaosConnectionString As String
Dim szAGSConnectionString As String
Dim szImpersonateContext As
System.Security.Principal.WindowsImpersonationContext
Dim szServer As String
Dim szDatabase As String
Dim szUserName As String
Dim szPassword As String
Dim M_Company As String ' This will allow you to set the company to know
which report to use
Dim M_EmailAddress As String 'This is the email address that the user
uses for their login
Dim M_OrderNumber As String 'This is the Order Number that they Use
Dim M_Report As ReportDocument ' This is the variable that declares the
report to be passed back
Dim MainReport As ReportDocument 'This is the Main report that the rest
of the code will use
#End Region
Public Property SetCompany() As String
'<PARA>
' This property is the first property that must be called from the
Order.aspx page as it is the one that is used to define
'the correct report to use
'</PARA>
'<VALUE>
'AGS
'BK
'OTHER
'</VALUE>
Get
SetCompany = M_Company
End Get
Set(ByVal Value As String)
M_Company = UCase(Value)
Select Case M_Company
Case "AGS"
MainReport = New AGS_WEB_ORDER
Case "BK"
MainReport = New BK_WEB_ORDER
Case "OTHER"
MainReport = New OTHER_WEB_ORDER
End Select
End Set
End Property
Public Property SetEmail() As String
'<PARA>
' This property is the first property that must be called from the
Order.aspx page as it is the one that is used to define
'the email address to use for the email address
'</PARA>
'<VALUE>
'(e-mail address removed)
'</VALUE>
Get
SetEmail = M_EmailAddress
End Get
Set(ByVal Value As String)
M_EmailAddress = Value
End Set
End Property
Public Property SetOrderNumber() As String
'<PARA>
'Pass this the order number
'</PARA>
'<VALUE>
'OrderNumber
'</VALUE>
Get
SetOrderNumber = M_OrderNumber
End Get
Set(ByVal Value As String)
M_OrderNumber = Value
End Set
End Property
Public ReadOnly Property Report() As ReportDocument
'<PARA>
'This passeds the report back to Order.aspx
'</PARA>
'
Get
Report = MainReport
End Get
End Property
Private Sub ReadRegistry()
Dim ParentKey As RegistryKey = Registry.LocalMachine
Dim SubKey As String = "SOFTWARE\KHAOS_PDF_EXPORT"
Dim Key As RegistryKey
Try
'Open the registry key.
Key = ParentKey.OpenSubKey(SubKey, True)
If Key Is Nothing Then 'if the key doesn't exist
Throw New Exception("The registry key doesn't exist")
End If
'Get the value.
szErrorMailPrimary = CType(Key.GetValue("MainErrorMail"), String)
szErrorMailSecondary = CType(Key.GetValue("SecondErrorMail"),
String)
szMailServer = CType(Key.GetValue("MailServerIPAddress"), String)
szMailFrom = CType(Key.GetValue("MailFromAddress"), String)
szPathToPDF = CType(Key.GetValue("PathToPDF"), String)
szPathToExport = CType(Key.GetValue("PathToExport"), String)
szKhaosConnectionString =
CType(Key.GetValue("ConnectionString"), String)
szAGSConnectionString =
CType(Key.GetValue("AGSConnectionString"), String)
szServer = CType(Key.GetValue("Server"), String)
szDatabase = CType(Key.GetValue("DB"), String)
szUserName = CType(Key.GetValue("User"), String)
szPassword = CType(Key.GetValue("Password"), String)
Catch e As Exception
'EventLog.CreateEventSource("KhaosXML", "Unable to Pen Khaos
Registry Settings. The following error occured " & e.Message,
EventLogEntryType.Error,1970)
MsgBox(e.Message)
'TODO Put proper error trapping in
End Try
End Sub
Private Sub ErrorMail()
'This is the function that sends an email to the relevant people in
the event of a failure
Try
Dim sysMessage As New MailMessage
sysMessage.From = szMailFrom
sysMessage.To = szErrorMailPrimary
sysMessage.Cc = szErrorMailSecondary
sysMessage.Subject = "WARNING WARNING - ERROR WITH WEB ORDER"
Dim szBody As String
szBody = szBody & "There has been a problem recorder in the
evvent log of the database server." & vbCrLf
szBody = szBody & "This event log warning will tell you what has
gone wrong and where." & vbCrLf
szBody = szBody & "Please inform an administrator as soon as
possible please." & vbCrLf & vbCrLf
sysMessage.Body = szBody
SmtpMail.SmtpServer = szMailServer
SmtpMail.Send(sysMessage)
Catch ex As Exception
EventLog.WriteEntry("KhaosXML", "Unable to email PDF. The
following error occurred " & ex.Message, EventLogEntryType.Error, 1970)
Exit Sub
End Try
End Sub
Function EmailPDF() As ReportDocument
'This creates the fucntion that emails the PDF to the customer
Dim exportFilePath As String
Dim oguid As Guid
Dim szFileName As String = oguid.NewGuid.ToString
Dim crTable As CrystalDecisions.CrystalReports.Engine.Table
Dim iCount As Integer
Try
MainReport = ChangeLogOnInfo(MainReport, "HERA", "reporter",
"reporter")
'OK We know set the parameters required by the report
Dim crParameterDiscreteValue As ParameterDiscreteValue
Dim crParameterFieldDefinitions As ParameterFieldDefinitions
Dim crParameterFieldLocation As ParameterFieldDefinition
Dim crParameterValues As ParameterValues
crParameterFieldDefinitions =
MainReport.DataDefinition.ParameterFields
crParameterFieldLocation =
crParameterFieldDefinitions.Item("OrderNumber")
crParameterValues = crParameterFieldLocation.CurrentValues
crParameterDiscreteValue = New
CrystalDecisions.Shared.ParameterDiscreteValue
crParameterDiscreteValue.Value = M_OrderNumber
crParameterValues.Add(crParameterDiscreteValue)
crParameterFieldLocation.ApplyCurrentValues(crParameterValues)
MainReport = ChangeLogOnInfo(MainReport, "HERA", "reporter",
"reporter")
'MainReport.PrintToPrinter(1, False, 1, 1)
'Try
' Dim sysMessage As New MailMessage
' sysMessage.From = szMailFrom
' sysMessage.To = M_EmailAddress
' sysMessage.Subject = "Confirmation of Order at The Adult Gift
Shop Limited"
' Dim szBody As String
' szBody = szBody & "We enlose a PDF version of your order for
your records." & vbCrLf
' szBody = szBody & "If you do not have adobe acrobat reader
installed please click on the link below to install it" & vbCrLf
' szBody = szBody &
"http://www.adobe.com/products/acrobat/readstep2.html" & vbCrLf & vbCrLf
' szBody = szBody & "Please do not reply to this email address
all emails. Should be addressed to (e-mail address removed)" & vbCrLf
' szBody = szBody & vbCrLf & vbCrLf & "Thankyou for shopping at
the Adult Gift Shop"
' sysMessage.Body = szBody
' Dim sysAttachment As MailAttachment = New
MailAttachment(exportFilePath, MailEncoding.Base64)
' sysMessage.Attachments.Add(sysAttachment)
' SmtpMail.SmtpServer = szMailServer
' SmtpMail.Send(sysMessage)
' If IO.File.Exists(exportFilePath) Then
' IO.File.Delete(exportFilePath)
' End If
'Catch ex As Exception
' EventLog.WriteEntry("KhaosXML", "Unable to email PDF. The
following error occurred " & ex.Message & "Order Number " & M_OrderNumber & "
Email Address " & M_EmailAddress & ".", EventLogEntryType.Error, 1970)
' ErrorMail()
' Exit Function
'End Try
Catch ex As Exception
MsgBox(ex.Message)
End Try
Return MainReport
End Function
Private Function ChangeLogOnInfo(ByVal Report As ReportDocument, ByVal
ServerName As String, ByVal UserName As String, ByVal Password As String) As
ReportDocument
Dim crConnectionInfo As New ConnectionInfo
With crConnectionInfo
.ServerName = ServerName
.UserID = UserName
.Password = Password
End With
Dim crTable As Table
Dim LogOnInfo As TableLogOnInfo
For Each crTable In Report.Database.Tables
LogOnInfo = crTable.LogOnInfo
'Debug.Write(crTable.Name)
''OK If I get this right we dont need to chnage database names
but will need to chnage servers and usernames and passwords as we
'' may have subreports pointing to different areas
'LogOnInfo.ConnectionInfo.DatabaseName = Database
LogOnInfo.ConnectionInfo.ServerName = ServerName
LogOnInfo.ConnectionInfo.UserID = UserName
LogOnInfo.ConnectionInfo.Password = Password
'LogOnInfo.ConnectionInfo = crConnectionInfo
crTable.ApplyLogOnInfo(LogOnInfo)
Next
'OK AND NOW WE DO THE SUB REPORTS
Dim crReportObject As ReportObject
Dim crReportObjects As ReportObjects
Dim crSection As Section
Dim crSections As Sections
Dim SubReportObject As SubreportObject
Dim subReportDocument As ReportDocument
Dim crSubTable As Table
Dim crSubTables As Tables
Dim crSubLogOnInfo As TableLogOnInfo
crSections = Report.ReportDefinition.Sections
For Each crSection In crSections
crReportObjects = crSection.ReportObjects
For Each crReportObject In crReportObjects
If TypeOf crReportObject Is SubreportObject Then
SubReportObject = CType(crReportObject, SubreportObject)
subReportDocument =
SubReportObject.OpenSubreport(SubReportObject.SubreportName)
crSubTables = subReportDocument.Database.Tables
For Each crSubTable In crSubTables
crSubLogOnInfo = crSubTable.LogOnInfo
crSubLogOnInfo = crTable.LogOnInfo
crSubLogOnInfo.ConnectionInfo.ServerName = ServerName
crSubLogOnInfo.ConnectionInfo.UserID = UserName
crSubLogOnInfo.ConnectionInfo.Password = Password
crSubTable.ApplyLogOnInfo(LogOnInfo)
Next
End If
Next
Next
Return Report
End Function
End Class
viewer but not in a webform. I get the usual
CrystalReports.EngineLogONException logon Failed when this is called in aspx.
Any help will be very much apprecaited
Alixx
This is the code in the calling aspx Page
Imports CrystalDecisions.CrystalReports
Imports CrystalDecisions.ReportSource
Imports CrystalDecisions.Shared
Imports CrystalDecisions.Web
Imports CrystalDecisions.Windows.Forms
Imports CrystalDecisions.CrystalReports.Engine
Public Class Order
Inherits System.Web.UI.Page
#Region " Web Form Designer Generated Code "
'This call is required by the Web Form Designer.
Protected WithEvents WebViewer As CrystalDecisions.Web.CrystalReportViewer
Protected WithEvents PrintReport As System.Web.UI.WebControls.ImageButton
Protected WithEvents Label1 As System.Web.UI.WebControls.Label
<System.Diagnostics.DebuggerStepThrough()> Private Sub
InitializeComponent()
End Sub
'NOTE: The following placeholder declaration is required by the Web Form
Designer.
'Do not delete or move it.
Private designerPlaceholderDeclaration As System.Object
Private Sub Page_Init(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles MyBase.Init
'CODEGEN: This method call is required by the Web Form Designer
'Do not modify it using the code editor.
InitializeComponent()
End Sub
#End Region
Private Sub Page_Load(ByVal sender As Object, ByVal e As
System.EventArgs) Handles MyBase.Load
Dim DoReport As New Order_Class
DoReport.SetCompany = "BK"
DoReport.SetEmail = "(e-mail address removed)"
DoReport.SetOrderNumber = "223"
Dim szResponse As String = DoReport.CreateOrder()
Dim MyReport As ReportDocument
MyReport = DoReport.EmailPDF
Me.WebViewer.ReportSource = MyReport
End Sub
End Class
Ok this is the start of the code for the class that I call the main
function is emailPDFwhich calls ChangeLogOnInfo EmailPDF returns a Report
Document which so that it can be viewed; eventually it will be exported as
PDF as well(note I have tried just exporting it but doesnt seem to work).
#Region "Imports_Declared"
Imports System.Data.SqlClient
Imports System.Data.SqlClient.SqlCommand
Imports System.Data.SqlClient.SqlConnection
Imports System.IO.BinaryWriter
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared
Imports CrystalDecisions.ReportSource
Imports CrystalDecisions.Web
Imports CrystalDecisions.Windows.Forms
Imports System.Web
Imports System.Web.Mail
Imports System.Diagnostics
Imports Microsoft.Win32
Imports System.Runtime.InteropServices
Imports System.Security.Principal
#End Region
#Region "Boiler_Plate"
'########################################################################
'# Web Order Class Version 2.0 #
'# Created By Alixx Skevington #
'# #
'# This will create the XML dcoument that is needed for Khaos #
'# That will eventually automatically imported into the database #
'# Then Automatically email's the customer and the shop #
'# And also displays a copy of the report to have it printed #
'# Revision History None #
'########################################################################
#End Region
Public Class Order_Class
Public Enum CompanyInfo
AGS
BK
OTHER
End Enum
#Region "Global Variables Declared"
Dim szErrorMailPrimary As String ' This is where all the mail messages
will go
Dim szErrorMailSecondary As String 'This is where all the mail messages
will go to make sure soembody gets them
Dim szMailServer As String 'this is the address of the mail server
Dim szMailFrom As String 'this is who the mail is from
Dim szPathToPDF As String
Dim szPathToExport As String
Dim szKhaosConnectionString As String
Dim szAGSConnectionString As String
Dim szImpersonateContext As
System.Security.Principal.WindowsImpersonationContext
Dim szServer As String
Dim szDatabase As String
Dim szUserName As String
Dim szPassword As String
Dim M_Company As String ' This will allow you to set the company to know
which report to use
Dim M_EmailAddress As String 'This is the email address that the user
uses for their login
Dim M_OrderNumber As String 'This is the Order Number that they Use
Dim M_Report As ReportDocument ' This is the variable that declares the
report to be passed back
Dim MainReport As ReportDocument 'This is the Main report that the rest
of the code will use
#End Region
Public Property SetCompany() As String
'<PARA>
' This property is the first property that must be called from the
Order.aspx page as it is the one that is used to define
'the correct report to use
'</PARA>
'<VALUE>
'AGS
'BK
'OTHER
'</VALUE>
Get
SetCompany = M_Company
End Get
Set(ByVal Value As String)
M_Company = UCase(Value)
Select Case M_Company
Case "AGS"
MainReport = New AGS_WEB_ORDER
Case "BK"
MainReport = New BK_WEB_ORDER
Case "OTHER"
MainReport = New OTHER_WEB_ORDER
End Select
End Set
End Property
Public Property SetEmail() As String
'<PARA>
' This property is the first property that must be called from the
Order.aspx page as it is the one that is used to define
'the email address to use for the email address
'</PARA>
'<VALUE>
'(e-mail address removed)
'</VALUE>
Get
SetEmail = M_EmailAddress
End Get
Set(ByVal Value As String)
M_EmailAddress = Value
End Set
End Property
Public Property SetOrderNumber() As String
'<PARA>
'Pass this the order number
'</PARA>
'<VALUE>
'OrderNumber
'</VALUE>
Get
SetOrderNumber = M_OrderNumber
End Get
Set(ByVal Value As String)
M_OrderNumber = Value
End Set
End Property
Public ReadOnly Property Report() As ReportDocument
'<PARA>
'This passeds the report back to Order.aspx
'</PARA>
'
Get
Report = MainReport
End Get
End Property
Private Sub ReadRegistry()
Dim ParentKey As RegistryKey = Registry.LocalMachine
Dim SubKey As String = "SOFTWARE\KHAOS_PDF_EXPORT"
Dim Key As RegistryKey
Try
'Open the registry key.
Key = ParentKey.OpenSubKey(SubKey, True)
If Key Is Nothing Then 'if the key doesn't exist
Throw New Exception("The registry key doesn't exist")
End If
'Get the value.
szErrorMailPrimary = CType(Key.GetValue("MainErrorMail"), String)
szErrorMailSecondary = CType(Key.GetValue("SecondErrorMail"),
String)
szMailServer = CType(Key.GetValue("MailServerIPAddress"), String)
szMailFrom = CType(Key.GetValue("MailFromAddress"), String)
szPathToPDF = CType(Key.GetValue("PathToPDF"), String)
szPathToExport = CType(Key.GetValue("PathToExport"), String)
szKhaosConnectionString =
CType(Key.GetValue("ConnectionString"), String)
szAGSConnectionString =
CType(Key.GetValue("AGSConnectionString"), String)
szServer = CType(Key.GetValue("Server"), String)
szDatabase = CType(Key.GetValue("DB"), String)
szUserName = CType(Key.GetValue("User"), String)
szPassword = CType(Key.GetValue("Password"), String)
Catch e As Exception
'EventLog.CreateEventSource("KhaosXML", "Unable to Pen Khaos
Registry Settings. The following error occured " & e.Message,
EventLogEntryType.Error,1970)
MsgBox(e.Message)
'TODO Put proper error trapping in
End Try
End Sub
Private Sub ErrorMail()
'This is the function that sends an email to the relevant people in
the event of a failure
Try
Dim sysMessage As New MailMessage
sysMessage.From = szMailFrom
sysMessage.To = szErrorMailPrimary
sysMessage.Cc = szErrorMailSecondary
sysMessage.Subject = "WARNING WARNING - ERROR WITH WEB ORDER"
Dim szBody As String
szBody = szBody & "There has been a problem recorder in the
evvent log of the database server." & vbCrLf
szBody = szBody & "This event log warning will tell you what has
gone wrong and where." & vbCrLf
szBody = szBody & "Please inform an administrator as soon as
possible please." & vbCrLf & vbCrLf
sysMessage.Body = szBody
SmtpMail.SmtpServer = szMailServer
SmtpMail.Send(sysMessage)
Catch ex As Exception
EventLog.WriteEntry("KhaosXML", "Unable to email PDF. The
following error occurred " & ex.Message, EventLogEntryType.Error, 1970)
Exit Sub
End Try
End Sub
Function EmailPDF() As ReportDocument
'This creates the fucntion that emails the PDF to the customer
Dim exportFilePath As String
Dim oguid As Guid
Dim szFileName As String = oguid.NewGuid.ToString
Dim crTable As CrystalDecisions.CrystalReports.Engine.Table
Dim iCount As Integer
Try
MainReport = ChangeLogOnInfo(MainReport, "HERA", "reporter",
"reporter")
'OK We know set the parameters required by the report
Dim crParameterDiscreteValue As ParameterDiscreteValue
Dim crParameterFieldDefinitions As ParameterFieldDefinitions
Dim crParameterFieldLocation As ParameterFieldDefinition
Dim crParameterValues As ParameterValues
crParameterFieldDefinitions =
MainReport.DataDefinition.ParameterFields
crParameterFieldLocation =
crParameterFieldDefinitions.Item("OrderNumber")
crParameterValues = crParameterFieldLocation.CurrentValues
crParameterDiscreteValue = New
CrystalDecisions.Shared.ParameterDiscreteValue
crParameterDiscreteValue.Value = M_OrderNumber
crParameterValues.Add(crParameterDiscreteValue)
crParameterFieldLocation.ApplyCurrentValues(crParameterValues)
MainReport = ChangeLogOnInfo(MainReport, "HERA", "reporter",
"reporter")
'MainReport.PrintToPrinter(1, False, 1, 1)
'Try
' Dim sysMessage As New MailMessage
' sysMessage.From = szMailFrom
' sysMessage.To = M_EmailAddress
' sysMessage.Subject = "Confirmation of Order at The Adult Gift
Shop Limited"
' Dim szBody As String
' szBody = szBody & "We enlose a PDF version of your order for
your records." & vbCrLf
' szBody = szBody & "If you do not have adobe acrobat reader
installed please click on the link below to install it" & vbCrLf
' szBody = szBody &
"http://www.adobe.com/products/acrobat/readstep2.html" & vbCrLf & vbCrLf
' szBody = szBody & "Please do not reply to this email address
all emails. Should be addressed to (e-mail address removed)" & vbCrLf
' szBody = szBody & vbCrLf & vbCrLf & "Thankyou for shopping at
the Adult Gift Shop"
' sysMessage.Body = szBody
' Dim sysAttachment As MailAttachment = New
MailAttachment(exportFilePath, MailEncoding.Base64)
' sysMessage.Attachments.Add(sysAttachment)
' SmtpMail.SmtpServer = szMailServer
' SmtpMail.Send(sysMessage)
' If IO.File.Exists(exportFilePath) Then
' IO.File.Delete(exportFilePath)
' End If
'Catch ex As Exception
' EventLog.WriteEntry("KhaosXML", "Unable to email PDF. The
following error occurred " & ex.Message & "Order Number " & M_OrderNumber & "
Email Address " & M_EmailAddress & ".", EventLogEntryType.Error, 1970)
' ErrorMail()
' Exit Function
'End Try
Catch ex As Exception
MsgBox(ex.Message)
End Try
Return MainReport
End Function
Private Function ChangeLogOnInfo(ByVal Report As ReportDocument, ByVal
ServerName As String, ByVal UserName As String, ByVal Password As String) As
ReportDocument
Dim crConnectionInfo As New ConnectionInfo
With crConnectionInfo
.ServerName = ServerName
.UserID = UserName
.Password = Password
End With
Dim crTable As Table
Dim LogOnInfo As TableLogOnInfo
For Each crTable In Report.Database.Tables
LogOnInfo = crTable.LogOnInfo
'Debug.Write(crTable.Name)
''OK If I get this right we dont need to chnage database names
but will need to chnage servers and usernames and passwords as we
'' may have subreports pointing to different areas
'LogOnInfo.ConnectionInfo.DatabaseName = Database
LogOnInfo.ConnectionInfo.ServerName = ServerName
LogOnInfo.ConnectionInfo.UserID = UserName
LogOnInfo.ConnectionInfo.Password = Password
'LogOnInfo.ConnectionInfo = crConnectionInfo
crTable.ApplyLogOnInfo(LogOnInfo)
Next
'OK AND NOW WE DO THE SUB REPORTS
Dim crReportObject As ReportObject
Dim crReportObjects As ReportObjects
Dim crSection As Section
Dim crSections As Sections
Dim SubReportObject As SubreportObject
Dim subReportDocument As ReportDocument
Dim crSubTable As Table
Dim crSubTables As Tables
Dim crSubLogOnInfo As TableLogOnInfo
crSections = Report.ReportDefinition.Sections
For Each crSection In crSections
crReportObjects = crSection.ReportObjects
For Each crReportObject In crReportObjects
If TypeOf crReportObject Is SubreportObject Then
SubReportObject = CType(crReportObject, SubreportObject)
subReportDocument =
SubReportObject.OpenSubreport(SubReportObject.SubreportName)
crSubTables = subReportDocument.Database.Tables
For Each crSubTable In crSubTables
crSubLogOnInfo = crSubTable.LogOnInfo
crSubLogOnInfo = crTable.LogOnInfo
crSubLogOnInfo.ConnectionInfo.ServerName = ServerName
crSubLogOnInfo.ConnectionInfo.UserID = UserName
crSubLogOnInfo.ConnectionInfo.Password = Password
crSubTable.ApplyLogOnInfo(LogOnInfo)
Next
End If
Next
Next
Return Report
End Function
End Class