#Region "ExporttoPDF"

    Public Sub ExportToPDF2(ByVal strRptName As String)
        Dim strParam As String = ""
        Dim strPath As String = Application.StartupPath
        Dim objFS As Object
        Dim strPDF As Boolean = True
        Dim strDt_Fr As String = ""
        Dim strDt_To As String = ""
        Dim strEmployee_CD As String = ""
        Dim strNewName As String = ""
        Dim strOriginal, strOrignalPath, strNewRootName, strPDFName As String
        Dim strUniqueSuffix As String
        Dim strFormula As String

        If InStr(strPath, "bin", CompareMethod.Text) > 0 Then
            strRptPath = strPath.Substring(0, InStr(strPath, "bin", CompareMethod.Text) - 1)
        Else
            strRptPath = strPath
        End If
        If strRptPath.EndsWith("\") Then
        Else
            strRptPath = strRptPath & "\"
        End If

        Const ForReading = 1, ForWriting = 2, ForAppending = 8

        strOriginal = strRptPath
        objFS = CreateObject("Scripting.FileSystemObject")  ' Creating the instance of the FileSystem object form the scripting object.
        strRptPath += "Reports\PDF"
        Dim f, f1, fc, s
        f = objFS.GetFolder(strRptPath)
        fc = f.Files

        Dim p() As System.Diagnostics.Process = Process.GetProcesses(Dns.GetHostName)
        Dim i As Integer
        For i = 0 To p.Length - 1
            If p(i).ProcessName.Trim = "AcroRd32" Then
                p(i).Kill()
                Exit For
            End If
        Next

        For Each f1 In fc
            If objFS.FileExists(strRptPath & "\" & f1.name) Then
                objFS.DeleteFile(strRptPath & "\" & f1.name, True)
            End If
        Next

        strUniqueSuffix = "RptTest001" & Hour(Now) & Minute(Now) & Second(Now)

        strOrignalPath = strOriginal & "Reports\" & strRptName
        'strParam = "EMPCODE=" & strEmployee_CD & "" & "^^" & "FROM_DT=" & strDt_Fr & "" & "^^" & "TO_DT=" & strDt_To & ""
        'strParam = "FROM_DT=" & strDt_Fr & "" & "^^" & "TO_DT=" & strDt_To & "" & "^^" & "EMPCODE=" & strEmployee_CD & "" & "^^" & "FIN_YR=" & fin_yr & ""
        'strParam = "FROM_DT=" & strDt_Fr & "" & "^^" & "TO_DT=" & strDt_To & "" & "^^" & "EMPCODE ='1'" '& strEmployee_CD & ""

        If objFS.FileExists(strOrignalPath) Then
            strNewRootName = "Reports\PDF\" & strUniqueSuffix
            strNewName = strOriginal & strNewRootName & ".rpt"
            objFS.CopyFile(strOrignalPath, strNewName, True)
        End If

        Dim oPDFFile
        Dim bFileConverted

        oPDFFile = CreateObject("RPTToPDF.ExportToPDF")

        bFileConverted = oPDFFile.PopulateRPT(strOriginal & strNewRootName, strNewName, strParam, strFormula)

        'MsgBox(oPDFFile.mParamDesc2)
        'MsgBox(oPDFFile.mparamDesc1)

        If objFS.FileExists(strNewName) Then
            objFS.DeleteFile(strNewName, True)
        End If
        strPDFName = strOriginal & strNewRootName & ".pdf"

        Try
            If bFileConverted Then
                Process.Start(strPDFName)
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

    End Sub
#End Region

• Written by Santosh Kumar Singh.
• In category .Net.
• 15 years ago.

Hot Hits: 3385

Like it on Facebook, Tweet it or share this article on other bookmarking websites.