daheads blog²

Mit den folgenden Funktionen kann man mit Visual Basic .NET unter Verwendung der PDFCreator Library (Verweis!) PDF-Dateien drucken.

Die erste Funktion schickt dabei einfach alle gefundenen Dateien eines beliebigen Verzeichnisses an die Funktion "PrintPDFFile", welche letztendlich die PDF Datei erstellt.

 
Public Sub PrintDirectory(ByVal aSourceDirectory As String, ByVal aFileFilter As String)
 
    Dim lstFiles As System.Collections.ObjectModel.ReadOnlyCollection(Of String) = _
    My.Computer.FileSystem.GetFiles(aSourceDirectory, FileIO.SearchOption.SearchAllSubDirectories, aFileFilter)
 
    Dim fi As System.IO.FileInfo
    Dim fnnew As String
    Dim dirnew As String
 
    Dim pdfjob As New PDFCreator.clsPDFCreator
 
    If pdfjob.cStart("/NoProcessingAtStartup") = False Then
      MsgBox("Can't initialize PDFCreator.", vbCritical & vbOKOnly)
      Exit Sub
    End If
 
    For Each fn As String In lstFiles
      ' Create new filename
      fi = My.Computer.FileSystem.GetFileInfo(fn)
      fnnew = fi.Name
      fnnew = Replace(fnnew, fi.Extension, "") ' Remove old extension. Don't add new extension!
      dirnew = fi.Directory.FullName & "\"
 
      Me.PDFPrintFile(pdfjob, fi.FullName, fnnew, dirnew)
    Next
 
    pdfjob.cClose()
    pdfjob = Nothing
  End Sub
 

 
  Public Sub PDFPrintFile(ByRef aPDFJob As PDFCreator.clsPDFCreator, ByVal aFilename As String, ByVal aOutputFilename As String, ByVal aOutputPath As String)
 
    ' Exit it output filename already exists
    If System.IO.File.Exists(aOutputPath & aOutputFilename) Then
      Exit Sub
    End If
 
    ' Create Outputdirectory if not existant
    If Not System.IO.Directory.Exists(aOutputPath) Then
      System.IO.Directory.CreateDirectory(aOutputPath)
    End If
 
    With aPDFJob
      .cOption("UseAutosave") = 1
      .cOption("UseAutosaveDirectory") = 1
      .cOption("AutosaveDirectory") = aOutputPath
      .cOption("AutosaveFilename") = aOutputFilename
      .cOption("AutosaveFormat") = 0    ' 0 = PDF
      .cClearCache()
    End With
 
    'Print the document to PDF
    aPDFJob.cPrintFile(aFilename)
 
    'Wait until the print job has entered the print queue
    Do Until aPDFJob.cCountOfPrintjobs = 1
      ' My.Application.DoEvents.DoEvents()
    Loop
 
    aPDFJob.cPrinterStop = False
 
    'Wait until PDF creator is finished then release the objects
    Do Until aPDFJob.cCountOfPrintjobs = 0
      ' My.Application.DoEvents()
    Loop
 
  End Sub
 

Aktualisierung vom 03.08.2009:

Wie ich heute leider mal wieder feststellen musste, funktioniert obiger Code bei einer großen Menge an umzuwandelnden Dateien nicht sonderlich.

Das unten aufgeführte "Modul" hat bei mir soeben 1400 Word-Dokumente erfolgreich in PDF umgenwandelt.

Public Module modPrintPDF
 
  Public Sub Main()
 
    Dim strDir As String = "C:\Word\Serienbriefe\Einzelbriefe"
    PrintDirectoryPDF(strDir, "*.doc", strDir)
 
  End Sub
 
  Public Function PrintDirectoryPDF(ByVal aInputDirectory As String, ByVal aFilter As String, ByVal aOutputDirectory As String)
 
    Dim lstFiles As System.Collections.ObjectModel.ReadOnlyCollection(Of String) = _
    My.Computer.FileSystem.GetFiles(aInputDirectory, FileIO.SearchOption.SearchAllSubDirectories, aFilter)
 
    Dim pdfc As New PDFCreator.clsPDFCreator
    pdfc.cStart(, True)
 
    For Each fn As String In lstFiles
 
      ' Generate New Filename
      Dim fi As New IO.FileInfo(fn)
      Dim strNewFilename As String = fi.Name
      strNewFilename = Replace(strNewFilename, fi.Extension, ".pdf")
 
      ' Print File
      PrintPDF(pdfc, fn, aOutputDirectory, strNewFilename)
    Next
 
    Return True
 
  End Function
 
  Public Function PrintPDF(ByRef aPDFCreator As PDFCreator.clsPDFCreator, ByVal aPDFFile As String, ByVal aOutputPath As String, ByVal aOutputFilename As String) As Integer
 
    With aPDFCreator
      .cOption("UseAutosave") = 1
      .cOption("UseAutosaveDirectory") = 1
      .cOption("AutosaveFormat") = 0 ' 0 = PDF
      .cOption("AutosaveDirectory") = aOutputPath
      .cOption("AutosaveFilename") = aOutputFilename
      .cClearCache()
      .cPrintFile(aPDFFile)
    End With
 
  End Function
 
End Module
 

Das ganze habe ich aus dem Internet von Piyush Sha's Blog und noch etwas abgeändert, da der Code bei mir in der Praxis leider nicht funktioniert hat.

Erst die Sprach-Kürzel als Enum:

Public Enum eLocales
  ar
  bg
  hr
  cs
  da
  nl
  en
  fi
  fr
  de
  l
  hi
  ja
  ko
  no
  pl
  pt
  ro
  ru
  es
  sv
End Enum

Und hier die eigentliche Funktion die für die Übersetzung zuständig ist:

 ''' <summary>
  ''' Translates a text using the Google-API
  ''' </summary>
  ''' <param name="TextToTranslate"></param>
  ''' <param name="lngInput">Input Language</param>
  ''' <param name="lngOutput">Output Language</param>
  ''' <returns>The translated text</returns>
  ''' <remarks></remarks>
  Public Function TranslateText(ByVal TextToTranslate As String, ByVal lngInput As String, ByVal lngOutput As String) As String
    Dim result As String
 
    Try
      Dim url As String = [String].Format("http://www.google.com/translate_t?hl=en&ie=UTF8&text={0}&langpair={1}|{2}", TextToTranslate, lngInput, lngOutput)
      Dim webClient As New Net.WebClient()
      webClient.Encoding = System.Text.Encoding.Default
 
      result = webClient.DownloadString(url)
 
      Dim match As String = "id=result_box"
      Dim i As Integer = result.IndexOf(match) + 20
      Dim f As Integer = result.IndexOf(match) + 500
 
      result = Mid(result, i, f)
      result = Mid(result, result.IndexOf(">") + 2, Len(result))
      result = Mid(result, 1, result.IndexOf("</div>"))
 
      result = MakeHTMLValid(result)
    Catch ex As Exception
      result = String.Empty
    End Try
 
    Return result
 
  End Function

Update vom 28.02.2009:

Hier noch die kleine Hilfsfunktion um HTML-Zeichen einigermaßen valide zu machen. Ich weiß, dass das keine wirklich professionelle Lösung ist, daher habe ich den Code ursprünglich auch nicht gepostet. Da aber Nachfragen kamen, anbei als Ergänzung:

  ''' <summary>
  ''' Format HTML Code a bit
  ''' </summary>
  ''' <param name="aString">The text to format</param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Public Shared Function MakeHTMLValid(ByVal aString As String) As String
 
    Dim result As String = aString
 
    ' Replace Entities
    result = result.Replace("Ö", "&Ouml;")
    result = result.Replace("ö", "&ouml;")
    result = result.Replace("Ä", "&Auml;")
    result = result.Replace("ä", "&auml;")
    result = result.Replace("Ü", "&Uuml;")
    result = result.Replace("ü", "&uuml;")
    result = result.Replace("ß", "&szlig;")
 
    result = result.Replace("€", "&euro;")
 
    Return result
 
  End Function

This functions returns all sql tables from a given connection as a list of string.

Public Shared Function GetTableList(ByVal strCon As String) As List(Of String)
      ' Create result
      Dim lstResult As New List(Of String)
 
      Try
        Using con As New SqlClient.SqlConnection(strCon)
 
          Try
            con.Open()
          Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical)
          End Try
 
          ' Create command and execute it
          Dim cmd As New SqlClient.SqlCommand("SELECT Table_Name FROM Information_Schema.Tables", con)
          Dim dr As SqlClient.SqlDataReader = cmd.ExecuteReader
 
          ' Add all columns to our list
          Do While dr.Read
            lstResult.Add(dr("Table_Name").ToString)
          Loop
 
        End Using
      Catch ex As Exception
        MsgBox(ex.Message, MsgBoxStyle.Critical)
      End Try
 
      Return lstResult
    End Function

Simple function to get all columns from a sql table.

Note: You should prepare the sql statement and check it for injections...

 
Public Shared Function GetColumnList(ByVal strCon As String, ByVal aDatasetName As String, ByVal aTablename As String) As List(Of String)
      Dim lstResult As New List(Of String)
      Using con As SqlConnection = New SqlConnection(strCon)
        Try
          con.Open()
          Dim ds As New DataSet(aDatasetName)
          Dim da As SqlDataAdapter = New SqlDataAdapter("SELECT * FROM " & aTablename, con)
          da.Fill(ds, aTablename)
          For Each dt As DataTable In ds.Tables
            For Each dc As DataColumn In dt.Columns
              lstResult.Add(dc.Caption)
            Next
          Next
        Catch ex As Exception
          MsgBox(ex.Message, MsgBoxStyle.Critical)
          Return Nothing
        End Try
      End Using
      Return lstResult
    End Function
 

The following function returns all columns from a xml file as a list of string.

 
    Public Shared Function GetColumnList(ByVal aFilename As String) As List(Of String)
      If Not File.Exists(aFilename) Then
        Throw New System.IO.FileNotFoundException("File not found!", aFilename)
        Exit Function
      End If
      Dim lstResult As New List(Of String)
      Dim ds As New DataSet
      Try
        ds.ReadXml(aFilename, XmlReadMode.InferSchema)
        For Each dt As DataTable In ds.Tables
          For Each dc As DataColumn In dt.Columns
            lstResult.Add(dc.Caption)
          Next
        Next
      Catch ex As Exception
        MsgBox(ex.Message, MsgBoxStyle.Critical)
      End Try
      Return lstResult
    End Function
  End Class
 

The following function returns all tables in a list of string from a xml file.

 
    Public Shared Function GetTableList(ByVal aFilename As String) As List(Of String)
      If Not File.Exists(aFilename) Then
        Throw New System.IO.FileNotFoundException("File not found!", aFilename)
        Exit Function
      End If
      Dim lstResult As New List(Of String)
      Dim ds As New DataSet
      Try
        ds.ReadXml(aFilename, XmlReadMode.InferSchema)
        For Each dt As DataTable In ds.Tables
          lstResult.Add(dt.TableName)
        Next
      Catch ex As Exception
        MsgBox(ex.Message, MsgBoxStyle.Critical)
      End Try
      Return lstResult
    End Function
 

Mit der folgende Methoden lässt sich ein ReportViewer mit Daten aus einem XML File befüllen und anzeigen.
Den Report an sich kann man bequem im Visual Studio erstellen und abspeichern. Databindings und dergleichen sind nicht notwendig.

Die untere Methode ermöglicht das Speichern eines Reports als PDF-Datei.

Public Sub ShowReportViewer(ByVal aXMLFilename As String, ByVal aReportFilename As String, _
                              ByVal aDatasetName As String, ByVal aTableName As String, _
                              ByVal aDataTableIndex As Integer, _
                              Optional ByVal DoSaveReport As Boolean = False, Optional ByVal SaveReportAsFilename As String = "")
 
    If Not System.IO.File.Exists(aXMLFilename) Then
      MsgBox(String.Format("Die XML Datenquelle ""{0}"" wurde nicht gefunden!", aXMLFilename), MsgBoxStyle.Critical)
      Exit Sub
    End If
 
    If Not System.IO.File.Exists(aReportFilename) Then
      MsgBox(String.Format("Die Report Vorlage ""{0}"" wurde nicht gefunden!", aReportFilename), MsgBoxStyle.Critical)
      Exit Sub
    End If
 
    ' Create new DataSet and load Data from aXMLFilename into it
    Dim ds As New DataSet()
    ds.DataSetName = aDatasetName
    ds.ReadXml(aXMLFilename)
 
    ' Create Form
    Dim frm As New Windows.Forms.Form
    frm.StartPosition = Windows.Forms.FormStartPosition.CenterParent
    frm.Height = 400
    frm.Width = 400
 
    ' Create Report Data Source
    ' The most important part here is aDatasetName & "_" & aTablename
    Dim rds As New Microsoft.Reporting.WinForms.ReportDataSource(aDatasetName & "_" & aTableName, ds.Tables(aDataTableIndex))
 
    ' Create ReportViewer
    Dim rv As New Microsoft.Reporting.WinForms.ReportViewer
    rv.Dock = Windows.Forms.DockStyle.Fill
 
    ' Add ReportViewer to Form
    frm.Controls.Add(rv)
 
    ' Load Report Definition File
    Dim fs As New System.IO.FileStream(aReportFilename, IO.FileMode.Open)
    rv.LocalReport.LoadReportDefinition(fs)
 
    ' Add Report Data Source
    rv.LocalReport.DataSources.Clear()
    rv.LocalReport.DataSources.Add(rds)
    rv.RefreshReport()
    ' Save Report as File?
    If DoSaveReport Then
      SaveReport(rv.LocalReport, SaveReportAsFilename)
    End If
    ' Finally Show Form
    frm.ShowDialog()
  End Sub
 

 
  Public Sub SaveReport(ByVal aLocalReport As Microsoft.Reporting.WinForms.LocalReport, ByVal aFilename As String, Optional ByVal aRenderFormat As String = "PDF")
    ' Todo: Check if aFilename already exists and prompt user to overwrite/skip
    Dim warnings As Microsoft.Reporting.WinForms.Warning() = Nothing
    Dim streamids As String() = Nothing
    Dim mimeType As String = Nothing
    Dim encoding As String = Nothing
    Dim extension As String = Nothing
    Dim bytes As Byte()
    Try
      bytes = aLocalReport.Render(aRenderFormat, Nothing, mimeType, encoding, extension, streamids, warnings)
      Dim fs As New IO.FileStream(aFilename, System.IO.FileMode.Create)
      fs.Write(bytes, 0, bytes.Length)
      fs.Close()
    Catch ex As Exception
      ' AddToLog(ex.Message)
    End Try
  End Sub
 

Beispielaufruf:

 
  Public Sub Test()
    ShowReportViewer("C:\test.xml", "C:\repMain.rdlc", "NewDataSet", "Table", 0, True, "C:\test.pdf")
  End Sub