AUTOMATISATION EXÉCUTION CRYSTAL REPORT AVEC PASSAGE DE PARAMÈTRES

Imports CRAXDRT
Imports CrystalDecisions.Shared

Const DIR_RPT As String = "C:\rpt\"   'répertoire où sont stockés les .rpt à exécuter
Const SERVER As String = "Nom serveur"
Const DB As String = "Nom BD"
Const USER As String = "Nom utilisateur"
Const PWD As String = "Mot de passe"

Private Sub frmCR_Load()
        Me.Hide()
        Call executeCrystal()
        Me.Close()
End Sub

Private Sub executeCrystal()
        Dim crApplication As CRAXDRT.Application
        Dim crReport As CRAXDRT.Report
        Dim crTables As CRAXDRT.DatabaseTables
        Dim crTable As CRAXDRT.DatabaseTable
        Dim crParameterFieldDefs As CRAXDRT.ParameterFieldDefinitions
        Dim crParameterFieldDef As CRAXDRT.ParameterFieldDefinition

        Dim crConnectionInfo As New ConnectionInfo
        Dim crTableLogonInfos As New TableLogOnInfos
        Dim crTableLogonInfo As New TableLogOnInfo

        Dim cpt As Integer
        Dim i As Integer
        Dim nbreParam As Integer

        Dim orientationPapier
        Dim nomDLL
        Dim nomServeur
        Dim nomBD
        Dim userName
        Dim password

        Dim paramNomReport As String
        Dim paramTypeSortie As Integer
        Dim paramSortie As String
        Dim paramDate As Date
        Dim paramDate1 As String
        Dim paramDate2 As String

        Try
            For cpt = 0 To UBound(Environment.GetCommandLineArgs)
                Select Case cpt
                    Case 1
                        'Nom du Crystal Report (sans l'extension .rpt)
                        paramNomReport = Environment.GetCommandLineArgs(1)
                    Case 2
                        '1 = impression
                        '2 = sauvegarde sur le disque
                        paramTypeSortie = Environment.GetCommandLineArgs(2)
                    Case 3
                        'Selon paramTypeSortie : 
                        ' 1 = nom de l'imprimante
                        ' 2 = Chemin du répertoire de sauvegarde (avec "\" à la fin)
                        paramSortie = Environment.GetCommandLineArgs(3)
                    Case 4
                        'Date de Début (format jj/MM/aaaa)
                        paramDate1 = Environment.GetCommandLineArgs(4)
                    Case 5
                        'Date de Fin (format jj/MM/aaaa)
                        paramDate2 = Environment.GetCommandLineArgs(5)
                End Select
            Next

            If paramDate1 <> "" Then
                paramDate = CDate(paramDate1)
            End If

            With crConnectionInfo
                .ServerName = SERVER
                .DatabaseName = DB
                .UserID = USER
                .Password = PWD
            End With

            nomDLL = "Dll de la DB"
            nomServeur = crConnectionInfo.ServerName
            nomBD = crConnectionInfo.DatabaseName
            userName = crConnectionInfo.UserID
            password = crConnectionInfo.Password

            crApplication = CreateObject("CrystalRuntime.Application")
            crReport = crApplication.OpenReport(DIR_RPT & paramNomReport & ".rpt", OpenReportMethod.OpenReportByTempCopy)
            crParameterFieldDefs = crReport.ParameterFields

            '************* TABLES *************
            crTables = crReport.Database.Tables

            For Each crTable In crReport.Database.Tables
                crTable.SetLogOnInfo(nomServeur, nomBD, USER, PWD)
            Next crTable

            '************* PARAMETRES *************
            crReport.EnableParameterPrompting = False
            nbreParam = crParameterFieldDefs.Count

            For i = 1 To nbreParam

                crParameterFieldDef = crParameterFieldDefs.Item(i)

                If crParameterFieldDef.ReportName = "" Then
                    crParameterFieldDef.SetCurrentValue(paramDate)
                    If paramDate2 <> "" Then
                        paramDate = CDate(paramDate2)
                    End If
                End If
            Next i

            '************* CONNECTION BD *************
            crApplication.LogOnServer(nomDLL, nomServeur, nomBD, USER, PWD)

            If paramTypeSortie = 1 Then
                '************* IMPRESSION *************
                orientationPapier = crReport.PaperOrientation

                With crReport
                    .SelectPrinter("", paramSortie, "")
                    .PaperOrientation = orientationPapier
                    .PaperSource = crReport.PaperSource.crPRBinMiddle
                    .PrintOut(False, 1)
                End With

            Else
                If paramTypeSortie = 2 Then
                    '************* EXPORTATION *************
                    With crReport
                        .ExportOptions.FormatType = CRExportFormatType.crEFTCrystalReport
                        .ExportOptions.DestinationType = CRExportDestinationType.crEDTDiskFile

                        .ExportOptions.DiskFileName = paramSortie & paramNomReport & ".rpt"
                        .Export(False)
                    End With
                End If
            End If

        Catch ex As Exception
            MsgBox("ERREUR :" & ex.Message, MsgBoxStyle.Information, "Exécution du rapport " & paramNomReport)
        End Try

End Sub