Hallo zusammen!
Ich habe an einem VBA-Skript in Outlook rumgewerkelt, der bewirkt, dass die PDF-Anhänge von Mails, die vorher durch eine Regel in den Posteingangsordner "Rechnungen" verschoben wurden, automatisch ausgedruckt und auf dem PC abgespeichert werden. Von dort aus erfolgt später ein Upload durch ein externes Programm.
Soweit so gut, der Skript funktioniert. Ich würde den Ausdruck aber gerne noch mit einem Stempel versehen und weiß nicht, wie ich hier vorgehen muss.
Kann man das auf Outlook adaptieren und wenn ja, wie?
Hier einmal mein Ausgangsskript:
Public Sub Rechnung_drucken_hochladen()
Dim folder_name As String
Dim objPosteingang As MAPIFolder
Dim objNewMail As MailItem
On Error Resume Next
Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Rechnungen")
For Each objNewMail In objPosteingang.Items
With objNewMail
If .UnRead = True Then
Anzahl = .Attachments.Count
If Anzahl > 0 Then
folder_name = "C:\Users\{Benutzename}\Documents\Belegtransfer\Rechnungseingang"
MkDir folder_name
For i = 1 To Anzahl
If Right(.Attachments.Item(i).FileName, 3) = "pdf" Then
my_name = Replace(Str(Date), ".", "_") & "__" & Replace(Str(Time), ":", "_") & "__" & .Attachments.Item(i).FileName
.Attachments.Item(i).SaveAsFile folder_name & "\" & my_name
print_me = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32 /h /p /t " & folder_name & "\" & my_name)
End If
Next i
End If
End If
.UnRead = False
Shell ("C:\Program Files (x86)\Belegtransfer\DATEV.BEDI.BelegTransfer")
End With
Next objNewMail
End Sub