VBA Tools

Jak wydrukować wiadomość z załącznikiem PDF?

Coraz częściej spotykamy się z wiadomościami, które zawierają faktury czy dokumenty eksportowane do pliku PDF. W większości przedsiębiorstwach jest wymóg, aby dokumenty takie zostały przedrukowane i dołączone w formie papierowej w tradycyjnym archiwum (np. w księgowości).

MS Outlook po wciśnięciu opcji drukowania ogranicza nasz wydruk jedynie do treści wiadomości. Co z załącznikami? W tym przypadku standardowo należy otworzyć załącznik i jeszcze raz wykonać tą samą czynność. Dobrze by było to zautomatyzować i to bez otwierania emaili (np. dla zaznaczonych w folderze widoku wiadomości).

Poniżej przestawiony kod realizuje opisane założenie:

Option Explicit
Dim oMail As MailItem, item As Object
Dim oAtmt As Attachment, FileName$

Sub drukuj()
'Dla wszystkich plików PDF
Call PrintPDFAttachments4SelectionEmail()
'Dla tylko tych które w nazwie zawierają słowo "faktura"
'Call PrintPDFAttachments4SelectionEmail("faktura")

For Each oMail In Application.ActiveExplorer.Selection
 oMail.PrintOut 'Można zwielokrotnić drukowanie powielając tą linię
Next
End Sub

Private Sub PrintPDFAttachments4SelectionEmail(Optional AttName$)
'MVP OShon from VBATools.pl
Dim oMail As MailItem, item As Object
Dim oAtmt As Attachment, FileName$, x&

 If FileExists("C:\Temp") = False Then MkDir "C:\Temp"
 On Error GoTo blad

 For Each item In Application.ActiveExplorer.Selection
 If item.Class = 43 Then
 Set oMail = item
 If oMail.Attachments.Count > 0 Then
 For Each oAtmt In oMail.Attachments
 If Len(AttName) = 0 Then
ones:
 FileName = "C:\Temp\" & oAtmt.FileName
 If FileExists(FileName) = True Then Kill FileName 'lub odpytanie komendą MSGBOX z parametrem.
 oAtmt.SaveAsFile FileName
 If Right$(UCase(oAtmt.FileName), 3) = "PDF" Then
 Shell """c:\Program Files (x86)\Adobe\Reader 9.0\Reader\acrord32.exe"" /h /p """ + FileName + """", vbHide
 End If
 Else
 If InStr(1, UCase(oAtmt.FileName), UCase(AttName)) > 0 Then GoTo ones
 End If
 Next oAtmt
 End If
 End If
 Next item
Exit Sub
blad:
MsgBox Err.Number & vbCr & Err.Description, vbExclamation, "O'Shon from VBATools.pl"
End Sub
Private Function FileExists(FilePath As String) As Boolean
On Error GoTo blad
 FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0
Exit Function
blad:
FileExists = False
End Function

Ze względu na możliwość instalacji AcrobatReadera w różnych konfiguracjach należy w kodzie podać poprawną ścieżkę do pliku „acrord32.exe”.

W przypadku problemów z samym wydrukiem PDFa (krzaki), należy pamiętać, iż w konfiguracji drukarki dobrze jest zaznaczyć, aby w Acrobacie Drukowanie/Zaawansowane ustawić „Drukować jako obraz”.

Aby zautomatyzować pracę można też przypisać makro „drukuj” do przycisku w pasku menu lub skorzystać z automatu, tworząc nową regułę w Kreatorze reguł „Menu/Reguły i alerty”.

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.