Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

outlook macro save attachment to file

Posted on 2011-03-23
3
Medium Priority
?
697 Views
Last Modified: 2012-05-11
Hello,
I have a macro that saves an excel attachment of an e-mail to a specified folder on the harddisk. In this case, to "C:\Fixing Centa FXIP Index Report\FXIP1\".
I would also like to save it to another folder at the same time:
"C:\Fixing Centa FXIP Index Report\FXIP2\".

Can you help please?

Thanks,
Chris
Sub SaveAttachmentsToDiskRuleFXIP1(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:\Fixing Centa FXIP Index Report\FXIP1\"
    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

0
Comment
Question by:CC10
  • 2
3 Comments
 
LVL 76

Accepted Solution

by:
David Lee earned 1000 total points
ID: 35200200
Hi, Chris.

If I've understood correctly you want the code to save to two folders simultaneously.  Assuming that's correct, then this should do it.
Sub SaveAttachmentsToDiskRuleFXIP1(olkMessage As Outlook.MailItem)
    'Change the path on the following line to the folder you want the attachments save in
    Const FOLDER_PATHS = "C:\Fixing Centa FXIP Index Report\FXIP1\,C:\Fixing Centa FXIP Index Report\FXIP2\"
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String, _
        arrFolders As Variant, _
        varFolder As Variant
    arrFolders = Split(FOLDER_PATHS, ",")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    If olkMessage.Attachments.count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            For Each varFolder In arrFolders
                strFilename = olkAttachment.FileName
                intCount = 0
                Do While True
                    If objFSO.FileExists(varFolder & strFilename) Then
                        intCount = intCount + 1
                        strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
                    Else
                        Exit Do
                    End If
                Loop
                olkAttachment.SaveAsFile varFolder & strFilename
            Next
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

0
 

Author Closing Comment

by:CC10
ID: 35200382
Great. Thanks vm.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 35200700
You're welcome.  Glad I could help.
0

Featured Post

Veeam Disaster Recovery in Microsoft Azure

Veeam PN for Microsoft Azure is a FREE solution designed to simplify and automate the setup of a DR site in Microsoft Azure using lightweight software-defined networking. It reduces the complexity of VPN deployments and is designed for businesses of ALL sizes.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Are you looking for the options available for exporting EDB files to PST? You may be confused as they are different in different Exchange versions. Here, I will discuss some options available.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

926 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question