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
Random Solutions  
 
programming4us programming4us