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
