|
|
Question : Rule that forwards attachments to a folder
|
|
Ok - Here's what I am working with:
I have a person scanning charts for me, and forwarding to my mailbox as PDFs. These are in the few thousands and they come in an auto-generated filename, but they are all PDFs. They come from ONE email address "[email protected]".
I want a rule in Microsoft Outlook that does exactly the following:
It should take ALL the PDF attachments that come from email address "[email protected]" and move the attachments to a specified folder in my computer. (Say C:\My Documents\PDFs)
Help me!
Thanks.
|
Answer : Rule that forwards attachments to a folder
|
|
super786,
Here it is. Follow these instructions to make use of it.
1. Start Outlook. 2. Click Tools->Macro->Visual Basic Editor. 3. If not already expanded, expand Modules and click on Module1. 4. Copy the code below and paste it into the right-hand pane of the VB Editor. 5. Edit the code as needed. I placed comment lines where things need to change. 6. Click the diskette icon on the toolbar to save the changes. 7. Close the VB Editor. 8. Click Tools->Macro->Security. 9. Change the Security Level setting to Medium. 10. Create a rule that runs when a new message arrives. Set it to check for messages from the address you listed. Set the rule to run the macro. The final rule should look something like this:
Apply this rule after the message arrives with "[email protected]" in the sender's address and on this machine only move it to the Car_Mileage folder and run Modules.SaveAttachmentsToDisk
Sub SaveAttachmentsToDisk(Item As Outlook.MailItem) Dim olkFolder As Outlook.MAPIFolder, _ olkAttachment As Outlook.Attachment, _ objFSO As Object, _ strRootFolderPath As String, _ strFilename As String, _ intCount As Integer 'Change the path on the following line to the folder you want the attachments save in strRootFolderPath = "C:\eeTesting\Attachments\" Set objFSO = CreateObject("Scripting.FileSystemObject") Set olkFolder = Application.ActiveExplorer.CurrentFolder If Item.Attachments.Count > 0 Then For Each olkAttachment In Item.Attachments If objFSO.GetExtensionName(LCase(olkAttachment.FileName)) = "pdf" Then strFilename = olkAttachment.FileName intCount = 0 Do While True If objFSO.FileExists(strRootFolderPath & strFilename) Then intCount = intCount + 1 strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName Else Exit Do End If Loop olkAttachment.SaveAsFile strRootFolderPath & strFilename End If Next End If Set objFSO = Nothing Set olkAttachment = Nothing Set olkFolder = Nothing End Sub
|
|
|
|
|