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.

Auf einem anderen Forum, das wohl seit 2014 nicht betrieben wird, habe ich einen ähnlichen Thread gefunden, hier ging es aber um eine Excel-VBA. Hier der Link: http://www.office-loesung.de/ftopic559757_0_0_asc.php

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

Danke im Voraus!