How to convert office (excel or word) to pdf with custom properties mapped to fields or ranges?I am using
I am using SolidWorks PDMPro to create pdf's from office documents. A task action tool in PDM provides a way to pass variable data from the donor office files custom document properties to tools that create the same custom properties in the pdf. However what is missing for this pdf to mirror the functionality of the office document is code for linking the custom properties in the pdf to the appropriate data fields as they were in the donor office document. The custom properties in the office documents are linked to named ranges (excel) or fields (word) and the PDM system is able to read and write to those custom properties which in turn update what is shown in those ranges or fields. This is referred to as dynamic content. We use this to update descriptions, signatures and dates, etc.
Here is the bit of code found in the advanced scripting options of the PDM task. It is missing the code to transfer the mapping of the custom properties to fields of the donor file to the pdf. I have no idea how to modify this to get this to work. Ideally I would like some code that is simple and generalizes the process to simply include "all linked ranges(fields) to custom properties copy to same" in concept.
Imports System
Imports System.IO
Imports System.Windows.Forms
Imports Microsoft.VisualBasic
Imports System.Text
Imports System.Linq
Namespace SolidWorks
Public Class TaskAddin
Public Enum FileType
Word
Excel
PowerPoint
Unknown
End Enum
Public Sub Log(message)
' Determine error log output path
Dim errorLogPath As Object = ""
Dim errorLogFolder As Object = "[TempErrorLogPath]"
errorLogPath = Path.Combine(errorLogFolder, "<TaskInstanceGuid>.log")
' Write error to output file
Dim objWriter As New System.IO.StreamWriter(errorLogPath, True)
objWriter.WriteLine( "[" + Date.Now.ToString("dd.MM.yyyy HH:mm:ss.fff") + "]" + message)
objWriter.Close()
End Sub
Public Function Main(paramarray prmParameters() as object) as object
Dim FileType as FileType = FileType.<FileType>
Select Case FileType
Case FileType.Word
Return ConvertWordDocToPDF()
Case FileType.Excel
Return ConvertExcelFileToPDF()
Case FileType.PowerPoint
Return ConvertPPFileToPDF()
Case Else
Log( "File's type is not suitable for conversion" )
End Select
Return False
End Function
Public Function IsProtected(file__1 As [String]) As [Boolean]
Dim bytes As [Byte]() = File.ReadAllBytes(file__1)
Dim prefix As [String] = Encoding.[Default].GetString(bytes.Take(2).ToArray())
' Zip and not password protected.
If prefix = "PK" Then
Return False
End If
' Office format.
If prefix = "ÐÏ" Then
' XLS 2003
If bytes.Skip(&H208).Take(1).ToArray()(0) = &HFE Then
Return True
End If
' XLS 2005
If bytes.Skip(&H214).Take(1).ToArray()(0) = &H2F Then
Return True
End If
' DOC 2005
If bytes.Skip(&H20B).Take(1).ToArray()(0) = &H13 Then
Return True
End If
' Guessing
If bytes.Length < 2000 Then
Return False
End If
' DOC/XLS 2007+
Dim start As [String] = Encoding.[Default].GetString(bytes.Take(2000).ToArray()).Replace(vbNullChar, " ")
If start.Contains("E n c r y p t e d P a c k a g e") Then
Return True
End If
Return False
End If
' Unknown format.
Return False
End Function
Public Function ConvertWordDocToPDF() As Boolean
Dim success As Boolean = False
Try
'Log("Initialize application")
Dim wordType As Type = Type.GetTypeFromProgID("Word.Application")
Dim wordApp As Object
Try
wordApp = Activator.CreateInstance(wordType)
Catch ex As Exception
Log("No version of Word installed on this system")
Return False
End Try
'Word.Application wordApp = new Word.Application();
wordApp.Visible = False
Try
'Log("Open document")
Dim docPath As Object = ""
docPath = Path.Combine("<SourceFolderPath>", "<SourceFileName>")
If IsProtected(docPath) Then
Log("The document " & docPath & " is protected, it cannot be handled by the addin.")
Return False
End If
Dim doc As Object = wordApp.Documents.Open(docPath)
Dim paramExportFormat As Int32 = 17
Dim paramOpenAfterExport As Boolean = False
Dim paramExportOptimizeFor As Int32 = 0 'WdExportOptimizeFor.wdExportOptimizeForPrint
Dim paramExportRange As Int32 = [__MS_WORD_EXPORT_RANGE ]'WdExportRange.wdExportAllDocument
Dim paramStartPage As Int32 = [__MS_WORD_START_RANGE ]
Dim paramEndPage As Int32 = [__MS_WORD_END_RANGE ]
Dim paramExportItem As Int32 = [__MS_WORD_MARKUP ] 'WdExportItem.wdExportDocumentContent
Dim paramIncludeDocProps As Boolean = [__MS_WORD_DOC_PROP]
Dim paramKeepIRM As Boolean = True
Dim paramDocStructureTags As Boolean = True
Dim paramBitmapMissingFonts As Boolean = True
Dim paramUseISO19005_1 As Boolean = False
'Word bookmarks takes precedence
'1 - WdExportCreateBookmarks.wdExportCreateHeadingBookmarks
'2 - WdExportCreateBookmarks.wdExportCreateWordBookmarks
Dim paramCreateBookmarks As Int32 = If(doc.Bookmarks.Count < 1, 1, 2)
' (int)Word.WdSaveFormat.wdFormatPDF = 17
'Log("Save document as pdf" + "[OutputPath]")
doc.ExportAsFixedFormat("[OutputPath]", _
paramExportFormat, paramOpenAfterExport, _
paramExportOptimizeFor, paramExportRange, paramStartPage, _
paramEndPage, paramExportItem, paramIncludeDocProps, _
paramKeepIRM, paramCreateBookmarks, _
paramDocStructureTags, paramBitmapMissingFonts, _
paramUseISO19005_1)
If Not String.IsNullOrEmpty("[Sec_OutputPath]") Then
'Log("Save document second output file as pdf" + "[Sec_OutputPath]")
doc.ExportAsFixedFormat("[Sec_OutputPath]", _
paramExportFormat, paramOpenAfterExport, _
paramExportOptimizeFor, paramExportRange, paramStartPage, _
paramEndPage, paramExportItem, paramIncludeDocProps, _
paramKeepIRM, paramCreateBookmarks, _
paramDocStructureTags, paramBitmapMissingFonts, _
paramUseISO19005_1)
End If
'Log("Close document")
Dim saveDoc As Object = False
' Close document
doc.Close(saveDoc)
'ComObjectCleanUp(doc)
success = True
Catch ex As Exception
' Problem saving the document
Log(ex.Message.ToString())
Finally
If wordApp IsNot Nothing Then
wordApp.Quit(Type.Missing, Type.Missing, Type.Missing)
'Marshal.FinalReleaseComObject(wordApp)
wordApp = Nothing
End If
End Try
Catch ex As Exception
' Unable to start Word
Log(ex.Message.ToString())
End Try
Return success
End Function
Public Function ConvertExcelFileToPDF() As Boolean
Dim success As Boolean = False
Try
Dim oldCulture = System.Threading.Thread.CurrentThread.CurrentCulture
Dim newCulture = New System.Globalization.CultureInfo("en-US")
System.Threading.Thread.CurrentThread.CurrentCulture = newCulture
'Log("Initialize Excel application")
Dim xlType As Type = Type.GetTypeFromProgID("Excel.Application")
Dim exApp As Object
Try
exApp = Activator.CreateInstance(xlType)
Catch ex As Exception
Log("No version of Éxcel installed on this system")
Return False
End Try
'Excel.Application exApp = new Excel.Application();
exApp.Visible = False
Dim ExportAllPage As Boolean = [__MS_EXCEL_EXPORTALL_PAGE]
Dim Format As Int32 = 0
Dim Quality As Int32 = 0
Dim IncludeDocProps As Boolean = [__MS_EXCEL_DOC_PROP]
Dim IgnorePrintAreas As Boolean = [__MS_WORD_PRINT_AREA]
Dim StartPage As Int32 = [__MS_EXCEL_START_RANGE]
Dim EndPage As Int32 = [__MS_EXCEL_END_RANGE]
Dim PageCount As Int32
Dim OpenAfterPublish As Boolean = False
Try
'Log("Open workbook")
Dim excelPath As Object = ""
excelPath = Path.Combine("<SourceFolderPath>", "<SourceFileName>")
If IsProtected(excelPath) Then
Log("The document " & excelPath & " is protected, it cannot be handled by the addin.")
Return False
End If
Dim wb As Object = exApp.Workbooks.Open(excelPath)
PageCount = wb.WorkSheets.count
If StartPage > PageCount Then
Log("The page selection is out of range.")
wb.Close(False)
Return False
End If
If EndPage > PageCount Then
Log("The page selection is out of range.")
wb.Close(False)
Return False
End If
exApp.DisplayAlerts = False
'Log("Export workbook as PDF" + "[OutputPath]" )
If ExportAllPage = True Then
wb.ExportAsFixedFormat(0, "[OutputPath]",
Quality,
IncludeDocProps,
IgnorePrintAreas )
Else
wb.ExportAsFixedFormat ( Format,
"[OutputPath]",
Quality,
IncludeDocProps,
IgnorePrintAreas,
StartPage,
EndPage,
OpenAfterPublish)
End If
If Not String.IsNullOrEmpty("[Sec_OutputPath]") Then
'Log("Export workbook as PDF" + "[Sec_OutputPath]")
If ExportAllPage = True Then
wb.ExportAsFixedFormat(0, "[Sec_OutputPath]",
Quality,
IncludeDocProps,
IgnorePrintAreas )
Else
wb.ExportAsFixedFormat ( Format,
"[Sec_OutputPath]",
Quality,
IncludeDocProps,
IgnorePrintAreas,
StartPage,
EndPage,
OpenAfterPublish)
End If
End If
exApp.DisplayAlerts = True
'Log("Close workbook")
' Do not save changes. May happen if the workbook is a legacy one. Task server cannot respond to this.
wb.Close(False)
'ComObjectCleanUp(wb)
success = True
Catch ex As Exception
If System.Runtime.InteropServices.Marshal.GetHRForException(ex) = -2146827284 Then
Log("The page selection is out of range.")
Return False
End If
Log(ex.Message.ToString())
Finally
If exApp IsNot Nothing Then
'Log("Quit Excel application")
exApp.Quit()
'Marshal.FinalReleaseComObject(exApp)
exApp = Nothing
End If
System.Threading.Thread.CurrentThread.CurrentCulture = oldCulture
End Try
Catch ex As Exception
Log(ex.Message.ToString())
End Try
Return success
End Function
Public Function ConvertPPFileToPDF() As Boolean
Dim success As Boolean = False
Try
Dim ppType As Type = Type.GetTypeFromProgID("PowerPoint.Application")
Dim ppApp As Object
Try
ppApp = Activator.CreateInstance(ppType)
Catch ex As Exception
Log("No version of PowerPoint installed on this system")
Return False
End Try
Try
'Log("Open presentation")
Dim ppPath As Object = ""
ppPath = Path.Combine("<SourceFolderPath>", "<SourceFileName>")
If IsProtected(ppPath) Then
Log("The document " & ppPath & " is protected, it cannot be handled by the addin.")
Return False
End If
' (int)Office.MsoTriState.msoTrue = -1, (int)Office.MsoTriState.msoFalse = 0
Dim ppPresentation As Object = ppApp.Presentations.Open(ppPath, -1, 0, 0)
' (int)PowerPoint.PpSaveAsFileType.ppSaveAsPDF = 32
'Log("Save presentation as pdf")
'ppPresentation.SaveAs("[OutputPath]", 32)
Dim ExportAllPage As Boolean = [__MS_PPT_EXPORTALL_PAGE]
Dim Intent As Int32 = 1
Dim FrameSlides As Int32 = [__MS_PPT_FRAMESLIDES]
Dim HandoutOrder As Int32 = 0
Dim OutputType As Int32 = 1
Dim PrintHiddenSlides As Int32 = [__MS_PPT_INC_HIDDEN_SLIDES]
Dim RangeType As Int32 = 1
Dim StartPage As Int32 = [__MS_PPT_START_RANGE]
Dim EndPage As Int32 = [__MS_PPT_END_RANGE]
Dim SlideShowName As String = ""
Dim IncludeDocProperties As Boolean = [__MS_PPT_DOC_PROP]
Dim PrintRange As object = ppPresentation.PrintOptions.Ranges.Add(StartPage, EndPage)
If ExportAllPage = True Then
ppPresentation.ExportAsFixedFormat("[OutputPath]", 2, _
Intent, FrameSlides, HandoutOrder, _
OutputType, PrintHiddenSlides, _
PrintRange, RangeType, SlideShowName, IncludeDocProperties )
Else
ppPresentation.ExportAsFixedFormat("[OutputPath]", 2, _
Intent, FrameSlides, HandoutOrder, _
OutputType, PrintHiddenSlides, _
PrintRange, 4, SlideShowName, IncludeDocProperties )
End If
If Not String.IsNullOrEmpty("[Sec_OutputPath]") Then
'Log("Save presentation as pdf")
If ExportAllPage = True Then
ppPresentation.ExportAsFixedFormat("[Sec_OutputPath]", 2, _
Intent, FrameSlides, HandoutOrder, _
OutputType, PrintHiddenSlides, _
PrintRange, RangeType, SlideShowName, IncludeDocProperties )
Else
ppPresentation.ExportAsFixedFormat("[Sec_OutputPath]", 2, _
Intent, FrameSlides, HandoutOrder, _
OutputType, PrintHiddenSlides, _
PrintRange, 4, SlideShowName, IncludeDocProperties )
End If
End If
'Log("Close presentation")
ppPresentation.Close()
'Marshal.ReleaseComObject(ppPresentation)
ppPresentation = Nothing
success = True
Catch ex As Exception
If System.Runtime.InteropServices.Marshal.GetHRForException(ex) = -2147467259 Then
Log("The page selection is out of range.")
Return False
End If
' Problem saving the document
Log(ex.Message.ToString())
Finally
'Log("Quit PowerPoint application")
If ppApp IsNot Nothing Then
ppApp.Quit()
'Marshal.FinalReleaseComObject(ppApp)
ppApp = Nothing
End If
End Try
Catch ex As Exception
' Couldn't initialize ppApp
Log(ex.Message.ToString())
End Try
Return success
End Function
End class
End Namespace
Thank you,
Ron
AdChoices