asked on

Save attachments and file email

Hello All,

I would like to know anyone knows a function that will save the attachments of email with a specific subject ("Car Mileage Claim") to the windows directory ("C:\Car_Mileage_Attachments\"), and then move the email to an outlook folder ("Car_Mileage"). I would like this to run as the email comes in, but also when outlook opens to go through and check for any new emails.

Thanks, Dommie Lama

David Lee

Hi DomiLama,

This is possible with the combination of a rule and a macro. If using a macro is an option, then I can post the code and instructions for both.

Cheers!

DomiLama

ASKER

Hi BlueDevilFan, yeah I think that might do the job. Can you send the code and I'll give it a go.

Thanks.

Serena Hsi

Using VBA to Manage Your Outlook Email Attachments (tutorial and VBA walk-through)
http://www.fontstuff.com/outlook/oltut01.htm

Use the Rules wizard to trigger based on an email with an attachment, with "specific words" in the subject, perform a "custom action", and move the email to a "specified folder".

ASKER CERTIFIED SOLUTION

David Lee

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Todd Penland

I can't understand why - but this solution is not working for me. I've tried. The macro moves the message to the folder it should, but it does not save the attachments. I tried putting a break point in the code so that I could step through it but it appears that macro never runs because the break point is never reached. Any idea why?

Here's my rule:

Apply this rule after the message arrives
with New eBay Listing in the subject
and on this machine only
move it to the Completed Messages folder
and run Project1.SaveAttachmentsToDiskRule
and mark it as read

Sub SaveAttachmentsToDiskRule(olkMessage As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String
    'Change the path on the following line to the folder you want the attachments save in
    strRootFolderPath = "C:\eBayListings\"
    Stop
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    If olkMessage.Attachments.Count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            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
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

Todd Penland

Please disregard my previous post - I had forgotten to save the Project - that's why it wasn't working. Rookie mistake ;-)