Download files from emails in Outlook

Question

I want to download an Excel file off of emails received daily over the past year.

Each email has one Excel file and the names of the Excel files are the same except for the date, which is shown as 'YYYYMMDD'.

I have the mail with the Excel files in a folder in Outlook. I would like each Excel file to go to its corresponding month in a folder outside of Outlook.

I have code that downloads the Excel file but there are few barriers:

The macro only works once, I need it to work on a loop.
The macro looks for unread emails in my inbox and then downloads and associated Excel files. I would like the macro to either A. Look for emails for particular text in the subject or B. download the Excel files of any emails that are already read. When I change the code from [UNREAD]=True to [READ]=True it breaks.
Maybe the most important, I would like the Excel file to save to a particular month folder depending on what the date is on the Excel file. (this would be a folder outside of Outlook).
The macro saves a separate .pdf file every time an Excel file saves. The .pdf file doesn't show anything. If does not break anything but its not ideal.

Original code produced by Siddharth Rout: (Download attachment from Outlook and Open in Excel)

Here's the code I'm using:

Sub Stack_Overflow_Test()

    Dim olapp As Object
    Dim olmapi As Object
    Dim olmail As Object
    Dim olitem As Object
    Dim lrow As Integer
    Dim olattach As Object
    Dim str As String

    Const num As Integer = 6
    Const path As String = "S:\Actg\sec\TESTING\Attachments from 
    Outlook\October\"
    Const emailpath As String = "S:\Actg\sec\TESTING\Attachments from 
    Outlook\October\"
    Const olFolderInbox As Integer = 6

    Set olp = CreateObject("outlook.application")
    Set olmapi = olp.getnamespace("MAPI")
    Set olmail = olmapi.getdefaultfolder(num)

    If olmail.items.restrict("[UNREAD]=True").Count = 0 Then

    MsgBox ("No Unread mails")

    Else

        For Each olitem In olmail.items.restrict("[UNREAD]=True")
            lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

            Range("A" & lrow).Value = olitem.Subject
            Range("B" & lrow).Value = olitem.senderemailaddress
            Range("C" & lrow).Value = olitem.To
            Range("D" & lrow).Value = olitem.cc
            Range("E" & lrow).Value = olitem.body

            If olitem.attachments.Count <> 0 Then

                For Each olattach In olitem.attachments

                    olattach.SaveAsFile path & olattach.Filename

                Next olattach

            End If
    str = olitem.Subject
    str = Replace(str, "/", "-")
    str = Replace(str, "|", "_")
    Debug.Print str
            olitem.unread = False
            DoEvents
        Next olitem

    End If

    ActiveSheet.Rows.WrapText = False

End Sub

score 0 · Answer 1 · answered Oct 22 '18 at 05:59

You could set a macro Rule, Set run this script every day.

Please refer to this link to set URL :

Outlook's Rules and Alerts: Run a Script
Set [UNREAD] = false to get read emails
You could find specific date from Excel file Then set it for File name.

For more information, refer to this link:

Saving .XLSX Attachments from Outlook 2010 w/ VBA

Download files from emails in Outlook

1 Answers1