Mailanhänge automatisch löschen

29 January 2019 - 18:10 | Version 1 |

Worum geht es?

Code

Option Explicit

Public WithEvents SentMailItems As Outlook.Items
    Private Sub Application_Startup()
    Set SentMailItems = Outlook.Application.Session.GetDefaultFolder(olFolderSentMail).Items

    End Sub
    Sub SentMailItems_ItemAdd(ByVal Item As Object)
    Dim xSentMail As Outlook.MailItem
    Dim xAttachments As Outlook.Attachments
    Dim xAttachment As Outlook.Attachment
    Dim xAttachmentInfo As String
    Dim i As Long
    'On Error Resume Next
    If Item.Class = olMail Then
       Set xSentMail = Item
    End If
    If Left$(xSentMail.Subject, 26) = "Ein PDF aus dem Biblionetz" Then
        Set xAttachments = xSentMail.Attachments
        For i = xAttachments.Count To 1 Step -1
            Set xAttachment = xAttachments.Item(i)
            xAttachment.Delete
        Next

        'xSentMail.HTMLBody = "<HTML><BODY><font color=#FF0000>Attachment Removed: </font><br/></BODY></HTML>" & _
                         xAttachmentInfo & "<HTML><BODY><br/></BODY></HTML>" & xSentMail.HTMLBody
        xSentMail.Save
    End If

End Sub

Quelle: https://www.extendoffice.com/documents/outlook/5058-outlook-automatically-remove-attachments-sent-items.html

Code zertifizieren mit selfcert.exe

Im Verzeichnis C:\Program Files (x86)\Microsoft Office\root\Office16 den Befehl SELFCERT.EXE ausführen. Danach im VBA-Editor unter Extras den Punkt Digitale Signaturen auswählen.
This site is powered by FoswikiCopyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding arbeitsgruppe.ch? Send feedback
This page was cached on 07 Jun 2025 - 08:38.