Log in

Biblionetz

You are here: Biblionetz » MailanhaengeLoeschen

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