Der folgende Code für den PDF-Creator 1.7.3 speichert die aktive mail als PDF-Datei. Die Anhänge können separat als Datei auf Festplatte gespeichert werden. Am Ende des Makros muss man noch den Namen des Standarddruckers anpassen. In "sPDFName" steht der Name der für die PDF-Datei verwendet werden soll. "sPDFPath" enthält den Dateispeicherort.
Möchte man die PDF-Datei mit Kennwort versehen muss man ".cOption("PDFUseSecurity")" auf 1 setzen und die Kennwörter anpassen. ".cOption("PDFUserPass") " ist das Passwort zum Öffnen. ".cOption("PDFOwnerPass") = 1" ist das Bearbeitungskennwort, kann auf 0 gesetzt werden wenn es nicht benötigt wird.
Sub MailSpeichernAlsPDF()
Dim objInspector As Inspector
Dim SaveInAsFile As String
Dim sMasterPass As String
Dim sUserPass As String
Dim sPDFName As String
Dim sPDFPath As String
Dim obj As Object
Dim pdfjob As Object
Dim intAnlagen As Long
Dim i As Long
Shell "rundll32 printui.dll,PrintUIEntry /y /n PDFCreator"
On Error GoTo ende
If TypeOf Application.ActiveWindow Is Outlook.Explorer Then
Set obj = Application.ActiveWindow
Set obj = obj.Selection(1)
Else
Set objInspector = ActiveInspector
objInspector.Activate
If objInspector.IsWordMail Then
Set obj = Application.ActiveInspector.CurrentItem
End If
End If
sPDFName = Format(Now, "YYYY-MM-DD") & " " & obj.Subject & ".pdf"
sPDFPath = Environ("USERPROFILE") & "\Desktop\Outlooktest\"
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0
If MsgBox("Soll die Datei nach dem erstellen angezeigt werden?", vbYesNo, "Anzeigen?") = vbYes Then
.cOption("AutosaveStartStandardProgram") = 1
End If
.cOption("PDFUseSecurity") = 0
.cOption("PDFOwnerPass") = 1
.cOption("PDFOwnerPasswordString") = "Test"
.cOption("PDFUserPass") = 1
.cOption("PDFUserPasswordString") = "Test"
.cOption("PDFAes128Encryption") = 1
.cClearCache
End With
obj.PrintOut
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
With obj
intAnlagen = .Attachments.Count
If intAnlagen > 0 Then
If MsgBox("Möchten Sie die Anhänge separat speichern?", vbYesNo + vbQuestion, "Frage") = vbYes Then
For i = 1 To intAnlagen
SaveInAsFile = .Attachments.Item(i).Filename
If Right(SaveInAsFile, 3) = "jpg" Or Right(SaveInAsFile, 3) = "png" Or _
Right(SaveInAsFile, 3) = "gif" Or Right(SaveInAsFile, 4) = "jpeg" Then GoTo weiter
.Attachments.Item(i).SaveAsFile sPDFPath & "\" & SaveInAsFile
weiter:
Next i
End If
End If
MailDelete:
If MsgBox("Möchten Sie die Email löschen?", vbYesNo + vbQuestion, "Frage") = vbYes Then .Delete
End With
ende:
Shell "rundll32 printui.dll,PrintUIEntry /y /n ""Samsung ML-2850 Series"""
EndSub:
End Sub
VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0