save attachments vba - Google Search

This script may be useful to automate the constant email task of saving attachments. It can be applied as an Outlook rule to automatically save attachments for mail messages with a certain subject or sender. It should only be used against trusted senders and with a uniquely identifiable subject so as not to download corrupt or damaging files.

It is saved into the “c:\attach\” directory, however this could be substituted for a network share or Sharepoint folder in the code below.

To setup this rule in Outlook:

1. Tools – Macro – Visual Basic Editor

2. Right-click on Project 1 – Insert Module

3. Paste code below

4. Close window

5. Send yourself a message with the subject and attachment you want, or select an existing message.

6. Right-click on the message – Create Rule

7. Check sender and subject contains and select a part of the subject line that could be used to uniquely identify the email.

8. Click Advanced Options, confirm options and click Next

9. Check 'run a script', click 'a script' select Project1.SaveToFolder

10. Click OK

To turn off the rule:

1. Tools – Rules and Alerts – Uncheck or Delete the rule.

‘<CODE >

Sub SaveToFolder(MyMail As MailItem)

Dim strID As String

Dim objNS As Outlook.NameSpace

Dim objMail As Outlook.MailItem

Dim objAtt As Outlook.Attachment

Dim c As Integer

Dim save_name As String

'Place path to sav to on next line. Note that you must include the

'final backslash

Const save_path As String = "c:\attach\"

strID = MyMail.EntryID

Set objNS = Application.GetNamespace("MAPI")

Set objMail = objNS.GetItemFromID(strID)

If objMail.Attachments.Count > 0 Then

For c = 1 To objMail.Attachments.Count

Set objAtt = objMail.Attachments(c)

save_name = Left(objAtt.FileName, Len(objAtt.FileName) - 4)

'save_name = save_name & Format(objMail.ReceivedTime, "_mm-dd-yyyy_hhmm")

save_name = save_name & Right(objAtt.FileName, 4)

objAtt.SaveAsFile save_path & save_name

Next

End If

Set objAtt = Nothing

Set objMail = Nothing

Set objNS = Nothing

End Sub

Private Sub Application_Startup()

'MsgBox "Welcome, " & Application.GetNamespace("MAPI").CurrentUser

Application.ActiveExplorer.WindowState = olMaximized

End Sub

‘</CODE>

Excel Hacks book

save attachments vba - Google Search