次の方法で共有

How to remove attachments from outlook emails easily

  • [アーティクル]

I receive often emails with big attachment that fill my inbox space very quickly.
On the other side, I usually like both to remove these attach and keep the email to preserve the thread for future use. Outlook 2003 don't have this feature so I wrote the following VBA function I added to a button on my client that resolve easily this task.

 

TIP: You can select more message at once too. This is useful if you want to clear a big number of messages you already have archivied.

 

Hope this helps!

 

 

' by Nicola Delfino 30-03-2005
' based on code found at on https://www.outlookcode.com

 

' Setup and instructions
' (1) Digitally sign VBA project
' start->office->Microsoft office tools->digital certificates for VBA
' create a certificate
' (2) sign the code
' from VBA
' tools->digital signature-> (choose certificate)
' (3) add icon on toolbar
' from outlook
' tools->customize
' add icon on toolbar
' [rearrange commands] to change icon and name on toolbar
' (4) install [https://www.contextmagic.com/express-clickyes/]
' (5) be sure that tools->macros->security
' on "thrusted publishers" "trust all installed add-ins and templates" is checked

 

 

 

Public Sub StripAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolder As String

 

    Dim result

On Error Resume Next

result = MsgBox("do you want to remove attachments from selected file?", vbYesNo + vbQuestion)
If result = vbNo Then
Exit Sub
End If

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

 

    ' Check each selected item for attachments.
' If attachments exist, save them to the Temp
' folder and strip them from the item.
For Each objMsg In objSelection
' This code only strips attachments from mail items.
If objMsg.Class = olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for
' removing items from a collection. Otherwise,
' the loop counter gets confused and only every
' other item is removed.
strFile = ""
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.

strFile = strFile & objAttachments.Item(i).FileName & "-" & vbCrLf

' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
' Delete the attachment.
objAttachments.Item(i).Delete
Next i
strFile = strFile & "ATTACH REMOVED" & "-" & vbCrLf & vbCrLf

Dim objDoc As Object
Dim objInsp As Outlook.Inspector
Set objInsp = objMsg.GetInspector
Set objDoc = objInsp.WordEditor

objDoc.Characters(1).InsertBefore strFile
objDoc.Save
objMsg.HTMLBody = strFile + objMsg.HTMLBody

End If
objMsg.Save
End If
Next

 

ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Comments