Solved

outlook macro save attachment to file

Posted on 2011-03-23
3
689 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 250 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

NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

Question has a verified solution.

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

Read this checklist to learn more about the 15 things you should never include in an email signature.
How to resolve IMCEAEX NDRs in Exchange or Exchange Online related to invalid X500 addresses.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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 …

821 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