Function ConvertMSG(sAttachFileName As String) As String
Dim iRet As String = ""
Try
Dim RDOSession As New RDOSession
Dim msg As RDOMail
Try
msg = RDOSession.GetMessageFromMsgFile(sAttachFileName)
msg.SaveAs(sAttachFileName & ".html", rdoSaveAsType.olHTML)
'WriteFile("ConvertMSG: " & sAttachFileName & ".html", sFile, bDebug)
'CreatePDF(File.ReadAllText(sAttachFileName & ".html"), sAttachFileName & ".pdf")
iRet = funConvertDOCX(sAttachFileName & ".html")
'sAttachFileName = sAttachFileName & ".pdf"
Catch ex As Exception
MsgBox("Error: Cannot Convert ConvertMSG Page: " & vbCrLf & ex.Message)
bError = True
End Try
Catch ex2 As Exception
bError = True
MsgBox("Error: Cannot Convert ConvertMSG Page (ex2): " & vbCrLf & ex2.Message)
End Try
Return iRet
End Function
Convert DOC/x
Function funConvertDOCX(sSource As String) As String
Try
Dim word As Application = New Application()
Dim doc As Document = word.Documents.Open(sSource)
doc.Activate()
doc.SaveAs2(sSource & ".pdf", WdSaveFormat.wdFormatPDF)
doc.Close()
Return sSource & ".pdf"
Catch ex As Exception
MsgBox("Error: Cannot Convert DOCX Page: " & vbCrLf & ex.Message)
bError = True
End Try
Return ""
End Function
Convert XLS/x
Function funConvertExcel(sSource As String) As String
Dim oApplication As ApplicationClass = New ApplicationClass
Dim sOut As String = sSource & ".pdf"
Dim oWorkbook As Workbook = Nothing
Dim PDFFile As String = sOut
Dim pFormatType As XlFixedFormatType = XlFixedFormatType.xlTypePDF
Dim pQuality As XlFixedFormatQuality = XlFixedFormatQuality.xlQualityMinimum
Dim pIncludeDocProperties As Boolean = True
Dim pIgnorePrintAreas As Boolean = True
Dim pFrom As Object = Type.Missing
Dim pTo As Object = Type.Missing
Dim pOpenAfterPublish As Boolean = False
Try
oWorkbook = oApplication.Workbooks.Open(sSource)
Dim oWorksheet As Excel.Worksheet
oWorksheet = oApplication.Worksheets(1)
oWorksheet.PageSetup.FitToPagesWide = 1
oWorksheet.PageSetup.FitToPagesTall = 1
oWorksheet.PageSetup.Zoom = False
If Not oWorkbook Is Nothing Then
oWorkbook.ExportAsFixedFormat(pFormatType, PDFFile, pQuality,
pIncludeDocProperties,
pIgnorePrintAreas,
pFrom, pTo, pOpenAfterPublish)
End If
Catch ex As Exception
MsgBox("Error: Cannot Convert XLSX Page: " & vbCrLf & ex.Message)
bError = True
End Try
If Not oWorkbook Is Nothing Then
oWorkbook.Close(False)
oWorkbook = Nothing
End If
If Not oApplication Is Nothing Then
oApplication.Quit()
oApplication = Nothing
End If
GC.Collect()
GC.WaitForPendingFinalizers()
Return sOut
'Dts.TaskResult = ScriptResults.Success
End Function
Get All Pages of an Image
'https://stackoverflow.com/questions/401561/how-to-open-a-multi-frame-tiff-imageformat-image-in-net-2-0
Function GetAllPages(file As String) As List(Of Image)
Dim bitmap As Bitmap
Dim images As List(Of Image) = New List(Of Image)
Try
bitmap = Image.FromFile(file)
Dim count As Integer = bitmap.GetFrameCount(FrameDimension.Page)
For idx As Integer = 0 To count - 1
'For (Int() idx = 0; idx <count; idx++)
SetToolStripText(ToolStripStatusLabel1, "Image: " & idx)
'// save each frame to a bytestream
bitmap.SelectActiveFrame(FrameDimension.Page, idx)
Dim byteStream As MemoryStream = New MemoryStream()
bitmap.Save(byteStream, ImageFormat.Jpeg)
''// And then create a New Image from it
SetToolStripText(ToolStripStatusLabel1, "Adding Image")
images.Add(Image.FromStream(byteStream))
Next
Catch ex As Exception
bitmap = Image.FromFile(file)
images.Add(bitmap)
End Try
SetToolStripText(ToolStripStatusLabel1, "Returning images # " & images.Count)
Return images
End Function
Process Binder
Function ProcessBinder(lvItem As ListViewItem, lstOfTiffs As List(Of String)) As String
Dim lstForBinder As List(Of String) = New List(Of String)
Dim iTiffCount As Integer = 0
For Each sfile In lstOfTiffs
Dim sProcessFilename As String = ribWorkFolder.TextBoxText & "\" & Path.GetFileName(sfile)
If File.Exists(sProcessFilename) Then
SetToolStripText(ToolStripStatusLabel1, "File already exists: " & sProcessFilename)
Else
My.Computer.FileSystem.CopyFile(sfile, sProcessFilename)
SetToolStripText(ToolStripStatusLabel1, "File copied to: " & sProcessFilename)
End If
Dim iCount As Integer = 0
For Each bmp As Bitmap In GetAllPages(sProcessFilename)
SetToolStripText(ToolStripStatusLabel1, sProcessFilename & "_" & iCount & ".jpg")
Dim sFileNew = sProcessFilename & "_0" & iCount & ".jpg"
bmp.Save(sFileNew, ImageFormat.Jpeg)
Dim s_document As PdfDocument = New PdfDocument()
Threading.Thread.Sleep(1500)
Dim page As PdfPage = s_document.AddPage()
Dim gfx As XGraphics = XGraphics.FromPdfPage(page)
Dim Image As XImage = XImage.FromFile(sFileNew)
page.Width = Image.PointWidth
page.Height = Image.PointHeight
SetToolStripText(ToolStripStatusLabel1, "Drawing Image")
gfx.DrawImage(Image, 0, 0)
s_document.Save(sFileNew & ".pdf")
Dim lvs As ListViewItem.ListViewSubItem = lvItem.SubItems(4)
'My.Computer.FileSystem.DeleteFile(sFileNew)
SetToolStripText(ToolStripStatusLabel1, "Created: " & sFileNew & ".pdf")
lstForBinder.Add(sFileNew & ".pdf")
'My.Computer.FileSystem.DeleteFile(sFileNew)
iTiffCount += 1
iCount += 1
SetLVsubitem(lvs, iTiffCount)
Next
Next
Dim sBinderName As String = ribOutputFolder.TextBoxText & "\" & lvItem.Text & " " & lvItem.SubItems(1).Text & " " & Replace(lvItem.SubItems(2).Text, "/", "_") & ".pdf"
SetToolStripText(ToolStripStatusLabel1, "Creating Binder: " & sBinderName)
Dim bCreated As Boolean = False
If Not File.Exists(sBinderName) Then
SetToolStripText(ToolStripStatusLabel1, "Binder does not exist! ")
bCreated = True
CreatePDF(Now, sBinderName)
End If
For Each sFileBinder As String In lstForBinder
AddPDFtoExistingPDF(sFileBinder, sBinderName)
My.Computer.FileSystem.DeleteFile(sFileBinder)
Next
If bCreated Then
Debug.Print("Removing Page 0")
funDeletePage(sBinderName, 0)
End If
Dim lvsBinder As ListViewItem.ListViewSubItem = lvItem.SubItems(5)
SetLVsubitem(lvsBinder, sBinderName)
Return sBinderName
End Function
CreatePDFfromTIFFs