Macro to remove attachments (MS Outlook 2000 SP3 Internet Mail only)

Topic

New Reply

I have a large number of messages with attachments. All this attachments are stored elsewhere in the My Documents folder. I wish to retain the messages but remove the attachments. Is there a way to do this with a macro preferably on a batch basis? Doing it manually one at a time is a real pain!

Any help or advice will be very much appreciated.

Reply | Quote

Replies

Do you want to do all attachments in one message, or all attachments in selected messages in a folder, or all attachments in all messages in a folder?

Reply | Quote

There’s a choice? I am quite taken aback.!

I would like to remove all attachments in all messages in a folder please.

Reply | Quote

Sorry – I have had second thoughts on how to express what I want to do.

In a folder (eg Sent Items) I have messages without attachments & messages with attachments. I would like to remove all attachments from any messages with an attachment in that folder.

I hope this makes sense!

Reply | Quote

No problem, easiest way to do it is to check all messages for attachments and then remove them from the e-mails that have them. I just got a rush paid project, so someone else will probably get this to you before I get to it. (Hint to the good coders! )

Reply | Quote

Thanks John – I do know what to do. I was doing it manually & got fed up – that’s why I looking for a macro! {8;-))

I hope those coders you have called up respond otherwise I’ll have to go back to the manual & tedious way.

Good luck with your project.

Reply | Quote

Haven’t tested extensively, but this seems to do the job:

Sub RemoveAttachments()
Dim nsp As NameSpace
Dim fld As MAPIFolder
Dim itm As MailItem
Dim i As Integer
Dim intAttCount As Integer

Set nsp = GetNamespace(“MAPI”)
Set fld = nsp.PickFolder
If fld Is Nothing Then Exit Sub

For Each itm In fld.Items
intAttCount = itm.Attachments.Count
For i = intAttCount To 1 Step -1
itm.Attachments.Remove i
Next i
Next itm

Set itm = Nothing
Set fld = Nothing
Set nsp = Nothing
End Sub

Reply | Quote

Hello Hans,

Your macro, which I have pasted into module 1, works as far a picking a folder. When I press OK having selected the folder that dialogue sheet closes & nothing further seems to happen. For sure the attachments remain attached!

Reply | Quote

I forgot a crucial statement: itm.Save immediately above Next itm. John’s code does have the equivalent statement.

Reply | Quote

That’s ironic Hans, because a couple of months ago you fixed a piece of Outlook code for me where I forgot. the .Save command.

Reply | Quote

Yep, I remember that – now …

Reply | Quote

The man who never made a mistake (in this case an omission) never made anything!

It is wonderful to be able to come here & get such useful & good-humoured help. Do please keep it up.

Reply | Quote

Malcom, in additon to my code stamping the file name into the e-mail text, one other difference is that Hans version doesn’t save the files: he correctly read your request and saw that you have already saved them. I’m afraid I wasn’t as observant, but in the future you may find my version handy since it does the removal and the saving at the same time. Unfortunately the files all have to be saved to one location with this VBA method, but you can move them from the Target Folder to other Folders with File Explorer.

Reply | Quote

Your macro works fine for me. Thank you very much for your help. It is very much appreciated. The added facility of saving to a folder is a bonus that I will find very useful.

Thanj you again.

Reply | Quote

Here’s my fancier version that also stamps the file name into the e-mail, which I can’t live without because I deal with a lot of attachments. Replace “U:Temp” with your target directory.

Sub MoveAttachments()
Dim nsNS As NameSpace
Dim fldrSel As MAPIFolder
Dim itmMail As MailItem
Dim attFile As Attachment
Dim intCtr As Integer, intEdType As Integer
Dim strFileStamp As String
Const strTargFolder As String = “U:Temp”

Set nsNS = Application.GetNamespace(“MAPI”)
Set fldrSel = nsNS.PickFolder

On Error Resume Next
If Err.Number Or fldrSel.DefaultItemType olMailItem Then
Beep
MsgBox “This is not a Mail Folder, or you cancelled, or,” & _
vbLf & “an unknown error has occurred.”, vbExclamation
Exit Sub
End If
‘capture file names and text to be stamped
For Each itmMail In fldrSel.Items
If itmMail.Attachments.Count > 0 Then
intEdType = itmMail.GetInspector.EditorType
If intEdType olEditorWord Then
strFileStamp = “”
For Each attFile In itmMail.Attachments
‘store attachment file names
strFileStamp = strFileStamp & “Attachment:

Reply | Quote