PDF zusammenfügen

  • Outlook

Es gibt 8 Antworten in diesem Thema. Der letzte Beitrag () ist von Volker Bunge.

    PDF zusammenfügen

    Hallo zusammen,

    ich wollte mit Outlook 2019 Exchange ein Makro schreiben, welches mir den E-Mail Text und die Anhänge als PDF ausdruckt bzw. abspeichert.

    Mit diesem Code

    VB.NET-Quellcode

    1. ' https://ekiwi-blog.de/6533/vba-e-mail-pdf-anhang-drucken/
    2. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    4. Public Const Verz As String = "C:\Temp\Outlook\"
    6. Public OutlookDateiname As String
    8. Public Sub PrintSelectedAttachments()
    10. On Error Resume Next
    12. MkDir Verz
    14. On Error GoTo 0
    16. ' Nachricht als PDF abspeichern
    17. OutlookDateiname = SaveMessageAsPDF
    19. ' Anhänge abspeichern
    20. Dim Exp As Outlook.Explorer
    21. Dim Sel As Outlook.Selection
    22. Dim obj As Object
    23. Set Exp = Application.ActiveExplorer
    24. Set Sel = Exp.Selection
    26. For Each obj In Sel
    28. If TypeOf obj Is Outlook.MailItem Then
    30. PrintAttachments obj
    32. End If
    34. Next
    36. ' Alle zusammenfügen
    37. Dim Dateien As String
    38. Dim DateiSplit() As String
    39. Dim Ziel As String
    41. Dim mobjFSO As Object, mfsoFolder As Object, mfsoSubFolder As Object, mfsoFile As Object
    42. Set mobjFSO = CreateObject("Scripting.FileSystemObject")
    43. Set mfsoFolder = mobjFSO.GetFolder(Verz)
    45. On Error Resume Next
    47. Dateien = ""
    49. For Each mfsoFile In mfsoFolder.Files
    51. If Not mfsoFile Is Nothing Then
    53. If InStr(1, mobjFSO.GetFileName(mfsoFile), ".pdf") > 0 Then
    55. Dateien = Dateien & mfsoFile & "|"
    57. End If
    59. End If
    61. Next
    63. Dateien = Mid(Dateien, 1, Len(Dateien) - 1)
    64. pdf = New PDFSplitMerge.CPDFSplitMergeObj
    65. DateiSplit = Split(Dateien, "|")
    66. Ziel = Replace(DateiSplit(0), "00_", "99_")
    68. MsgBox (Ziel & vbCrLf & Dateien)
    70. Call pdf.Merge(Dateien, Ziel)
    71. pdf = Nothing
    73. MsgBox ("Fertig")
    75. End Sub
    77. Private Sub PrintAttachments(oMail As Outlook.MailItem)
    79. On Error Resume Next
    81. Dim colAtts As Outlook.Attachments
    82. Dim oAtt As Outlook.Attachment
    83. Dim sFile As String
    84. Dim sFileType As String
    85. Dim AnzahlAnhänge As Integer
    86. AnzahlAnhänge = 1
    87. Set colAtts = oMail.Attachments
    89. If colAtts.Count Then
    91. For Each oAtt In colAtts
    93. sFileType = LCase$(Right$(oAtt.FileName, 4))
    95. Select Case sFileType
    97. Case ".pdf"
    99. sFile = Verz & Format(AnzahlAnhänge, "00_") & OutlookDateiname & " " & oAtt.FileName
    100. oAtt.SaveAsFile sFile
    101. 'ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
    102. AnzahlAnhänge = AnzahlAnhänge + 1
    104. End Select
    106. Next
    108. End If
    110. End Sub
    112. Public Function SaveMessageAsPDF() As String
    114. Dim Selection As Selection
    115. Dim obj As Object
    116. Dim Item As MailItem
    117. Dim wrdApp As Word.Application
    118. Dim wrdDoc As Word.Document
    119. Set wrdApp = CreateObject("Word.Application")
    120. Set Selection = Application.ActiveExplorer.Selection
    122. For Each obj In Selection
    124. Set Item = obj
    125. Dim FSO As Object, TmpFolder As Object
    126. Dim OutlookDateiname As String
    127. Set FSO = CreateObject("Scripting.FileSystemObject")
    128. Set tmpFileName = FSO.GetSpecialFolder(2)
    129. OutlookDateiname = Item.Subject & " " & Item.CreationTime
    130. ReplaceCharsForFileName OutlookDateiname, "-"
    131. tmpFileName = Verz & "00_" & OutlookDateiname & ".mht" 'tmpFileName & "\" & OutlookDateiname & ".mht"
    132. Item.SaveAs tmpFileName, olMHTML
    133. Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=True)
    134. Dim WshShell As Object
    135. Dim SpecialPath As String
    136. Dim strToSaveAs As String
    137. Set WshShell = CreateObject("WScript.Shell")
    138. strToSaveAs = Verz & "00_" & OutlookDateiname & ".pdf"
    140. ' check for duplicate filenames
    141. ' if matched, add the current time to the file name
    142. If FSO.FileExists(strToSaveAs) Then
    144. OutlookDateiname = OutlookDateiname & Format(Now, "hhmmss")
    145. strToSaveAs = Verz & "00_" & OutlookDateiname & ".pdf"
    147. End If
    149. wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    150. strToSaveAs, ExportFormat:=wdExportFormatPDF, _
    151. OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
    152. Range:=wdExportAllDocument, From:=0, To:=0, Item:= _
    153. wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
    154. CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
    155. BitmapMissingFonts:=True, UseISO19005_1:=False
    157. Next obj
    159. wrdDoc.Close
    160. wrdApp.Quit
    161. Set wrdDoc = Nothing
    162. Set wrdApp = Nothing
    163. Set WshShell = Nothing
    164. Set obj = Nothing
    165. Set Selection = Nothing
    166. Set Item = Nothing
    167. SaveMessageAsPDF = OutlookDateiname
    169. End Function
    171. ' This function removes invalid and other characters from file names
    172. Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
    174. sName = Replace(sName, "/", sChr)
    175. sName = Replace(sName, "\", sChr)
    176. sName = Replace(sName, ":", sChr)
    177. sName = Replace(sName, "?", sChr)
    178. sName = Replace(sName, Chr(34), sChr)
    179. sName = Replace(sName, "<", sChr)
    180. sName = Replace(sName, ">", sChr)
    181. sName = Replace(sName, "|", sChr)
    182. sName = Replace(sName, "&", sChr)
    183. sName = Replace(sName, "%", sChr)
    184. sName = Replace(sName, "*", sChr)
    185. sName = Replace(sName, " ", sChr)
    186. sName = Replace(sName, "{", sChr)
    187. sName = Replace(sName, "[", sChr)
    188. sName = Replace(sName, "]", sChr)
    189. sName = Replace(sName, "}", sChr)
    190. sName = Replace(sName, "!", sChr)
    192. End Sub


    Kann ich schon den E-Mail Text und die PDF Anhänge super erstellen.

    Jetzt möchte ich diese PDF-Dateien der Reihe nach (00.., 01,, usw.) zu einer machen. (Deshalb auch die Nummerierung am Anfang der Dateien)

    Der Code (Zeile 63 – 73) läuft ohne Fehlermeldungen und so durch. Aber leider gibt es keine PDF-Datei. OK, dachte ich. der Code stammte ja auch aus einem VB.NET Projekt. Also schnell ein neues Testprojekt erstellt.

    VB.NET-Quellcode

    1. Imports PDFSplitMerge
    2. Public Class Form1
    3. Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    4. Dim Dateien As String
    5. Dim DateiSplit() As String
    6. Dim Ziel As String
    7. Dim pdf As Object
    8. Dateien = "C:\Temp\Outlook\00_Test-01.07.2020-10-58-23.pdf|C:\Temp\Outlook\01_Test-01.07.2020-10-58-23 3921_200701105659_001.pdf|C:\Temp\Outlook\02_Test-01.07.2020-10-58-23 3923_200701112544_001.pdf"
    9. pdf = New PDFSplitMerge.CPDFSplitMergeObj
    10. DateiSplit = Split(Dateien, "|")
    11. Ziel = Replace(DateiSplit(0), "00_", "99_")
    12. MsgBox(Ziel & vbCrLf & Dateien)
    13. pdf.Merge(Dateien, Ziel)
    14. pdf = Nothing
    15. End Sub
    16. End Class


    Den Verweis auf die passende DLL noch schnell gesetzt und gestartet.

    PDF wurde sauber und funktionsfähig erstellt. Also ist doch die DLL richtig installiert bzw. registriert und funktioniert.

    (Die Pfade habe ich aus Outlook kopiert und hier nur eingefügt).

    Jetzt halt meine Frage: Warum klappt das nicht mit Outlook? Oder gibt es da noch eine andere Möglichkeit?

    Freundliche Grüße
    Volker

    P.S. In Anhang mal die DLL-Datei
    Dateien

    Volker Bunge schrieb:

    Warum klappt das nicht mit Outlook?
    Weil Outlook keine .Net-APIs will sondern native WinAPIs.
    Ich hab's nicht analysiert, aber es könnte sein, dass die DLL auch einen nativen Einsprungspunkt für Merge hat, der eine andere Überladung hat.
    Du kannst ja mal testen, ob du mit pdf.Merge_2 oder pdf.Merge_3 zum Erfolg kommst.

    Ansonsten gibt's auch die Acrobat-Methode:
    wellsr.com/vba/2017/word/combi…th-vba-and-adobe-acrobat/
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Hallo petaod,

    vielen Dank für die Infos.

    Adobe kommt leider aus Kostengründen nicht in Frage.

    Dann werde ich mal versuchen ein OCX bzw. DLL zu schreiben, die ich dann ansprechen kann. Sollte dies dann auch nicht gehen, dann werde ich wohl ein kleines Zusatzprogramm schreiben, welches dann ein Verzeichnis überwacht und bei einer bestimmten Datei dann alle PDF zusammenfügt.

    Mit VB.NET klappt das Mergen ja super.

    Gibt es evtl. eine Möglichkeit mit folgenden PDF-Druckern
    Drag2PDF
    eDocPrinter PDF Pro
    ERP2PDF
    Microsoft Print to PDF
    PDFA-1b

    ein zusammenführen hinzubekommen?
    (Bei eDocPrinter PDF Pro und Microsoft Print to PDF bin ich mir sicher, dass es Drucker sind, bei den anderen nicht so. Alle tauchen aber bei der Druckerliste auf)

    Gruß

    Volker

    Du kannst vb.net-Code nicht eins zu eins in VBA übernehmen. Den muss man umschreiben.

    Ich kenne die PDFSplitMerge.dll nicht, nehme aber an. dass es sich um diese handeln müsste. -> guangmingsoft.net/PDFSplitMerge/index.htm
    Falls es so ist, dann schau dir das mitgelieferte Beispiel für VB an.

    Visual Basic-Quellcode

    1. Private Sub Form_Load()
    3. Dim pdf
    4. Set pdf = CreateObject("PDFSplitMerge.PDFSplitMerge.1")
    6. 'pdf.SetCode "Your license code here"
    8. pdf.Split "..\1.pdf", "1;1;1", "..\sp1-%d.pdf"
    9. pdf.Split "..\1.pdf", "1;2;3;4;1-2,3-4;1", "..\sp%d.pdf"
    11. pdf.Merge "..\sp0.pdf|..\sp1.pdf", "..\m1.pdf"
    12. pdf.Merge "..\1.pdf?1-2|..\sp1.pdf", "..\m2.pdf"
    13. pdf.Merge "..\1.pdf?1-2|..\sp1.pdf?2", "..\m3.pdf"
    15. Set pdf = Nothing
    17. End Sub


    Alternativ könntest du auch GhostScript verwenden. -> stackoverflow.com/questions/71…clude-original-file-names

    Hallo HenryV,

    der Code funktioniert so 1:1 auch in Outlook. (Die Splitt-Funktion habe ich nicht gebraucht, sollte aber auch so funktionieren.

    Da diese Lösung jetzt für 30-40 Benutzer sein soll, wie kann man bei Outlook die Makros zentral einbinden (so dass ich hier nur ändern muss und nicht bei jedem Benutzer)?

    (Bei Word funktioniert dies über den Autostart.)

    Gruß

    P.S.: Meine o. g. DLL ist das zwar nicht gewesen, ab die von Dir genannte hatte ich auch schon installiert)

    Volker

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Volker Bunge“ ()

    Hallo HenryV,

    Den Link schaue ich mir morgen mal an.

    Habe jetzt aber noch ein anderes Problem:

    Das erste Listing ab Zeile 88-108 soll mir alle Anhänge abspeichern. Wenn aber in meinem Mailtext auch noch Bilder drin sind, werden die auch abgespeichert. Das o. g. Listing habe natürlich schon um den Typ png und jpg erweitert und sieht jetzt so aus

    VB.NET-Quellcode

    1. Case ".png", ".jpg"
    2. sFile = Verz & Format(AnzahlAnhänge, "00_") & OutlookDateiname & " " & oAtt.FileName
    3. oAtt.SaveAsFile sFile
    4. 'ShellExecute 0, "print", sFile0, vbNullString, Verz, 0
    5. AnzahlAnhänge = AnzahlAnhänge + 1


    Da ich leider jetzt nicht mit Image1, Image2, Image3 filtern kann (das sind übrigens meine drei Bilder aus dem Mailtext), fällt diese Möglichkeit leider raus.

    Ich will also nur die Dateien abspeichern, die auch tatsächlich als Anhang angehängt sind. Die anderen Mailtextbilder sind ja schon in der ersten PDF mit drin.

    Hast Du, oder jemand anderes, hier eine Lösung parat?

    Gruß

    Volker

    Hallo HenryV,

    der Link hat mich leider nicht großartig weitergebracht. Habe aber trotzdem die Lösung gefunden (siehe Zeile 115 ff).

    Hier mal mein bisheriger kpl. Code.

    VB.NET-Quellcode

    1. ' https://ekiwi-blog.de/6533/vba-e-mail-pdf-anhang-drucken/
    2. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    4. Public Const Verz As String = "C:\Temp\Outlook\"
    5. Public Const ZielVerz As String = "C:\Users\bungev\Documents\SAP\SAP GUI\"
    7. Public OutlookDateiname As String
    8. Public Mailvom As String
    10. Public Sub PrintSelectedAttachments()
    11. MsgBox ("PDF erstellen starten")
    12. On Error Resume Next
    14. MkDir Verz
    15. MkDir ZielVerz
    17. ' Alte Dateien vorher löschen
    18. Kill Verz & "*.*"
    20. On Error GoTo 0
    22. ' Nachricht als PDF abspeichern
    23. OutlookDateiname = SaveMessageAsPDF
    25. ' Anhänge abspeichern
    26. Dim Exp As Outlook.Explorer
    27. Dim Sel As Outlook.Selection
    28. Dim obj As Object
    29. Set Exp = Application.ActiveExplorer
    30. Set Sel = Exp.Selection
    32. For Each obj In Sel
    34. If TypeOf obj Is Outlook.MailItem Then
    36. PrintAttachments obj
    38. End If
    40. Next
    42. ' Alle zusammenfügen
    43. Dim Dateien As String
    44. Dim DateiSplit() As String
    45. Dim Ziel As String
    47. Dim mobjFSO As Object, mfsoFolder As Object, mfsoSubFolder As Object, mfsoFile As Object
    48. Set mobjFSO = CreateObject("Scripting.FileSystemObject")
    49. Set mfsoFolder = mobjFSO.GetFolder(Verz)
    51. On Error Resume Next
    53. Dateien = ""
    55. For Each mfsoFile In mfsoFolder.Files
    57. If Not mfsoFile Is Nothing Then
    59. If InStr(1, mobjFSO.GetFileName(mfsoFile), ".pdf") > 0 Then
    61. Dateien = Dateien & mfsoFile & "|"
    63. End If
    65. End If
    67. Next
    69. Dateien = Mid(Dateien, 1, Len(Dateien) - 1)
    70. DateiSplit = Split(Dateien, "|")
    71. Ziel = Replace(DateiSplit(0), "00_", "99_")
    73. ' Herkunft: https://www.vb-paradise.de/index.php/Thread/131364-PDF-zusammenf%C3%BCgen/?postID=1135166#post1135236
    74. Dim pdf
    75. Set pdf = CreateObject("PDFSplitMerge.PDFSplitMerge")
    76. pdf.Merge Dateien, Ziel
    77. Set pdf = Nothing
    79. Dim Wahl As String
    80. Dim Dateiname As String
    81. Wahl = InputBox("Um welche Art von Schreiben handelt es sich?" & vbCrLf & vbCrLf & _
    82. "01. Fotos von Zählern" & vbCrLf & _
    83. "02. Zählerstände" & vbCrLf & vbCrLf & _
    84. "Bitte 1-2 eingeben oder selbst eine Art bestimmen.")
    86. Select Case Wahl
    87. Case "1"
    88. Dateiname = "Fotos von Zählern.pdf" ' " & OutlookDateiname & ".pdf"
    89. Case "2"
    90. Dateiname = "Zählerstände.pdf" ' " & OutlookDateiname & ".pdf"
    91. Case Else
    92. End Select
    93. Dateiname = ZielVerz & Dateiname
    95. FileCopy Ziel, Dateiname
    96. MsgBox ("Fertig")
    98. End Sub
    99. Private Sub PrintAttachments(oMail As Outlook.MailItem)
    101. On Error Resume Next
    103. Dim colAtts As Outlook.Attachments
    104. Dim oAtt As Outlook.Attachment
    105. Dim sFile As String
    106. Dim sFileType As String
    107. Dim AnzahlAnhänge As Integer
    108. AnzahlAnhänge = 1
    109. Set colAtts = oMail.Attachments
    111. If colAtts.Count Then
    113. For Each oAtt In colAtts
    114. ' http://www.office-loesung.de/ftopic634062_0_0_asc.php
    115. If InStr(1, oMail.HTMLBody, oAtt.FileName) > 0 Then
    116. ' MsgBox "Grafik befindet sich im Text"
    117. Else
    118. ' MsgBox "Grafik ist nicht im Text sondern ein richtiger Anhang"
    120. sFileType = LCase$(Right$(oAtt.FileName, 4))
    122. Select Case sFileType
    123. Case ".png", ".jpg", ".doc", "docx"
    125. sFile = Verz & Format(AnzahlAnhänge, "00_") & OutlookDateiname & " " & oAtt.FileName
    126. oAtt.SaveAsFile sFile
    127. ShellExecute 0, "print", sFile, vbNullString, Verz, 0
    128. AnzahlAnhänge = AnzahlAnhänge + 1
    130. Case ".pdf"
    132. sFile = Verz & Format(AnzahlAnhänge, "00_") & OutlookDateiname & " " & oAtt.FileName
    133. oAtt.SaveAsFile sFile
    134. 'ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
    135. AnzahlAnhänge = AnzahlAnhänge + 1
    137. End Select
    138. End If
    139. Next
    141. End If
    143. End Sub
    144. Public Function SaveMessageAsPDF() As String
    146. Dim Selection As Selection
    147. Dim obj As Object
    148. Dim Item As MailItem
    149. Dim wrdApp As Word.Application
    150. Dim wrdDoc As Word.Document
    151. ' Set wrdApp = CreateObject("Word.Application")
    153. ' Word schön geöffnet?
    154. On Error Resume Next
    155. Dim Wordschongestartet As Boolean
    157. ' For Each Process In Process.GetProcesses
    158. ' MsgBox (Process.Name)
    159. ' If InStr(1, Process.Name, "Word") > 0 Then
    160. ' 'er existiert!
    161. ' Wordschongestartet = True
    162. ' End If
    163. ' Next
    164. '
    166. Dim objWMI As Object, objProc As Object
    167. Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
    168. Set objProc = objWMI.ExecQuery("Select * from Win32_Process " & "Where Name = 'Winword.exe'")
    170. If objProc.Count = 0 Then
    171. Wordschongestartet = False
    172. Else
    173. Wordschongestartet = True
    174. objProc.Quit
    175. End If
    176. If Wordschongestartet = False Then
    177. Set wrdApp = CreateObject("Word.Application")
    178. End If
    179. On Error GoTo 0
    181. Set Selection = Application.ActiveExplorer.Selection
    183. For Each obj In Selection
    185. Set Item = obj
    186. Dim FSO As Object, TmpFolder As Object
    187. Dim OutlookDateiname As String
    188. Set FSO = CreateObject("Scripting.FileSystemObject")
    189. Set tmpFileName = FSO.GetSpecialFolder(2)
    190. OutlookDateiname = Item.Subject & " " & Item.CreationTime
    191. ReplaceCharsForFileName OutlookDateiname, "-"
    192. tmpFileName = Verz & "00_" & OutlookDateiname & ".mht" 'tmpFileName & "\" & OutlookDateiname & ".mht"
    193. Item.SaveAs tmpFileName, olMHTML
    194. Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=True)
    195. Dim WshShell As Object
    196. Dim SpecialPath As String
    197. Dim strToSaveAs As String
    198. Set WshShell = CreateObject("WScript.Shell")
    199. ' wrdApp.Visible = True
    201. ' Seitenränder einstellen auf ein geringes Mass
    202. With ActiveDocument.PageSetup
    203. .LineNumbering.Active = False
    204. .Orientation = wdOrientPortrait
    205. .TopMargin = CentimetersToPoints(1)
    206. .BottomMargin = CentimetersToPoints(1)
    207. .LeftMargin = CentimetersToPoints(0.5)
    208. .RightMargin = CentimetersToPoints(0.5)
    209. .Gutter = CentimetersToPoints(0)
    210. .HeaderDistance = CentimetersToPoints(1.27)
    211. .FooterDistance = CentimetersToPoints(1.27)
    212. .PageWidth = CentimetersToPoints(21.59)
    213. .PageHeight = CentimetersToPoints(27.94)
    214. .FirstPageTray = wdPrinterDefaultBin
    215. .OtherPagesTray = wdPrinterDefaultBin
    216. .SectionStart = wdSectionNewPage
    217. .OddAndEvenPagesHeaderFooter = False
    218. .DifferentFirstPageHeaderFooter = False
    219. .VerticalAlignment = wdAlignVerticalTop
    220. .SuppressEndnotes = False
    221. .MirrorMargins = False
    222. .TwoPagesOnOne = False
    223. .BookFoldPrinting = False
    224. .BookFoldRevPrinting = False
    225. .BookFoldPrintingSheets = 1
    226. .GutterPos = wdGutterPosLeft
    227. End With
    229. ' Grafiken auf eine bestimmte Breite proportional verkleinern
    230. Dim objImageShape As InlineShape
    231. Dim FesteBreite As Integer
    232. FesteBreite = CentimetersToPoints(20)
    234. For Each objImageShape In ActiveDocument.InlineShapes
    235. If objImageShape.Width > FesteBreite Then
    236. objImageShape.Width = FesteBreite
    237. objImageShape.Height = (objImageShape.Height / objImageShape.Width) * FesteBreite
    238. End If
    239. Next
    242. strToSaveAs = Verz & "00_" & OutlookDateiname & ".pdf"
    244. ' check for duplicate filenames
    245. ' if matched, add the current time to the file name
    246. If FSO.FileExists(strToSaveAs) Then
    248. OutlookDateiname = OutlookDateiname & Format(Now, "hhmmss")
    249. strToSaveAs = Verz & "00_" & OutlookDateiname & ".pdf"
    251. End If
    253. wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    254. strToSaveAs, ExportFormat:=wdExportFormatPDF, _
    255. OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
    256. Range:=wdExportAllDocument, From:=0, To:=0, Item:= _
    257. wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
    258. CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
    259. BitmapMissingFonts:=True, UseISO19005_1:=False
    261. Next obj
    263. wrdDoc.Close
    264. wrdApp.Quit
    265. Set wrdDoc = Nothing
    266. Set wrdApp = Nothing
    267. Set WshShell = Nothing
    268. Set obj = Nothing
    269. Set Selection = Nothing
    270. Set Item = Nothing
    271. SaveMessageAsPDF = OutlookDateiname
    273. End Function
    275. ' This function removes invalid and other characters from file names
    276. Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
    278. sName = Replace(sName, "/", sChr)
    279. sName = Replace(sName, "\", sChr)
    280. sName = Replace(sName, ":", sChr)
    281. sName = Replace(sName, "?", sChr)
    282. sName = Replace(sName, Chr(34), sChr)
    283. sName = Replace(sName, "<", sChr)
    284. sName = Replace(sName, ">", sChr)
    285. sName = Replace(sName, "|", sChr)
    286. sName = Replace(sName, "&", sChr)
    287. sName = Replace(sName, "%", sChr)
    288. sName = Replace(sName, "*", sChr)
    289. sName = Replace(sName, " ", sChr)
    290. sName = Replace(sName, "{", sChr)
    291. sName = Replace(sName, "[", sChr)
    292. sName = Replace(sName, "]", sChr)
    293. sName = Replace(sName, "}", sChr)
    294. sName = Replace(sName, "!", sChr)
    296. End Sub


    Was jetzt noch fehlt sind

    1. Überprüfen, ob Word evtl. schon gestartet ist und Word entweder schließen oder am besten den Verweis auf den aktiven Wordprozess setzen (es kann ja sein, dass der Benutzer Word schon geöffnet hat, dann darf natürlich Word nicht beendet werden.)
    2. Die Bilder und Word-Dokumente muss ich noch in einzelne PDF ausdrucken. Werde morgen mal nach einem passenden eDocPrintercode schauen. Dort kann man den Pfad und Dateinamen und noch so einige Parameter hoffentlich per Code einstellen.

    Gruß
    Volker

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Volker Bunge“ ()

Facebook
Telefonspende