We help IT Professionals succeed at work.

Outlook save attachment to folder

Steve
Steve asked
on
Hi

I'm looking for a script which i can use via Outlook macro to simplify a process.

A user has an outlook subfolder called POSTROOM.
In this folder are multiple emails with attachments
The script needs to look in the POSTROOM folder and save all attachments only (not the emails themselves) to c:\POSTROOM\ then put the original mail into Outlook deleted items.

I would like the user to be prompted to confirm running the script, told via message box how many attachments were saved and then prompted again to confirm before the files are deleted

Currently the above is done manually and takes a lot of time, hopefully this is an easy question/points for those in the know.

The idea being that the script provided would be assigned to a button in the user's Outlook ribbon so they can click it and it does the work for them.

We are running a mixture of Outlook 2003 and 2010 and it would need to run on both please.

Hope this makes sense.

Thanks in advance
Comment
Watch Question

Top Expert 2011

Commented:
Where is the postroom sub folder located in the outlook folder hierarchy?

C hris

Commented:
Here is a free add-in that removes attachments (from an outlook Folder you specify) to a disk folder.  It does not delete the original email message though.  

http://www.kopf.com.br/outlook/


Top Expert 2011

Commented:
Pending your response in re outlook folderpath I have a solution but first off ... Which mails are to be deleted?  All of them or just those processed with attachments.
Top Expert 2011
Commented:
As an example:

The following assumes every email is to be deleted, (complication is with regard to those with attachments so easiest solution is to delete all emails)

It assumes the postbox folder is off the inbox folder that is the default PST, but the precise path is an easy one to change.

Chris
Sub postroomer()
Dim itm As Variant
Dim FSO As Object
Dim userPrompt As Variant
Dim lngFileCount As Long
Dim lngFileInc As Long
Dim att As Attachment
Dim itmCount As Long

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists("c:\postroom") Then
        FSO.CreateFolder "c:\postroom"
    End If
    userPrompt = MsgBox("You are about to delete all attachments in emails of folder: " & vbCrLf & vbCrLf & Application.Session.GetDefaultFolder(olFolderInbox).Folders("postroom").folderPath & vbCrLf & vbCrLf & "Do you want to proceed?", vbCritical + vbYesNo, "Last Chance to change your mind!")
    If userPrompt = vbNo Then Exit Sub
    For Each itm In Application.Session.GetDefaultFolder(olFolderInbox).Folders("postroom").items
        For Each att In itm.Attachments
            lngFileInc = 1
            Do While FSO.FileExists("c:\postroom\" & Left(att.filename, InStrRev(att.filename, ".") - 1) & "_" & lngFileInc & Right(att.filename, Len(att.filename) - InStrRev(att.filename, ".") + 1))
                lngFileInc = lngFileInc + 1
            Loop
            att.SaveAsFile "c:\postroom\" & Left(att.filename, InStrRev(att.filename, ".") - 1) & "_" & lngFileInc & Right(att.filename, Len(att.filename) - InStrRev(att.filename, ".") + 1)
        Next
    Next
    userPrompt = MsgBox("You will now delete all emails in folder: " & vbCrLf & vbCrLf & Application.Session.GetDefaultFolder(olFolderInbox).Folders("postroom").folderPath & vbCrLf & vbCrLf & "Do you want to proceed?", vbCritical + vbYesNo, "Last Chance to change your mind!")
    If userPrompt = vbNo Then Exit Sub
    For itmCount = Application.Session.GetDefaultFolder(olFolderInbox).Folders("postroom").items.Count To 1 Step -1
        Application.Session.GetDefaultFolder(olFolderInbox).Folders("postroom").items(itmCount).Delete
    Next

End Sub

Open in new window

SteveIT Manager

Author

Commented:
Hi Sorry just got out of meeting

Postroom folder is directly under inbox, the idea being that the user will move all emails to be "processed" into this folder then run the script so that they end up only deleting/processing the emails in the postroom folder.

Top Expert 2011

Commented:
The supplied script ought to work then subject to the question about deleting everything in the folder

Chris
SteveIT Manager

Author

Commented:
Chris - amazing, thank you so much
SteveIT Manager

Author

Commented:
Awesome !
Top Expert 2011

Commented:
Glad it helped, as you rightly observed easy (ish) when you have a little knowledge.

Chris