Download e-mail attachments depending on subject line

[boyexcel]

Hi folks,

I'm quite a newbie when it comes to creating macros in Outlook and I've been researching on how to go about this as there's no recording app.

The issue that I'm having is that I am receiving several e-mails with the same subject line for the day but they contain different attachments.
For example:
Subject line: Daily activities: 03/26/2013
attached file: a.txt
Subject line: Daily activities: 03/26/2013
attached file: b.txt
Subject line: Daily activities: 03/26/2013
attached file: c.txt
Subject line: Daily activities: 03/26/2013
attached file: d.txt

I only download for example attachment a.txt and c.txt and start my work from there.

So my concern is, I would like to know how to create a macro to download specific attachments depending on the subject line and save it to a folder.

I can make use of a user prompt to enter the date to filter the subject lines containing the entered date and then automatically download the attachments that I needed to a folder.

Would this be possible?

Can it be implemented on Excel?

Please do not hesitate to reply if you need more information from me.

All suggestions will be greatly appreciated.

Thank you!

 

[John_w]

So my query is i am getting error when i am changing folder name "Saurabh" under Inbox (Outlook)
Error is - Run time error '-2147221233(8004010f)
Attempted operation failed. An object could not be faund.

    Set outFolder = outNs.Folders("Saurabh").Folders("Inbox")  'CHANGE FOLDER AS NEEDED

But your code is referencing the folder "Saurabh" above Inbox. If that folder doesn't exist you'll get that error.

To reference the folder below Inbox try:

Set outFolder = outNs.GetDefaultFolder(olFolderInbox).Folders("Saurabh")

Please use CODE tags when posting VBA code.

 

[Harish Kumar]

But your code is referencing the folder "Saurabh" above Inbox. If that folder doesn't exist you'll get that error.

To reference the folder below Inbox try:

Set outFolder = outNs.GetDefaultFolder(olFolderInbox).Folders("Saurabh")

Please use CODE tags when posting VBA code.

Wow......!!
It's really working ...Thankkkkkk youuuuuuu So much.......!!
Keep it up..........!!
I really didn't think so quick response.......!!
Thank you once again......!!

Regards,
Harish Kumar

 

[abhay_547]

But your code is referencing the folder "Saurabh" above Inbox. If that folder doesn't exist you'll get that error.

To reference the folder below Inbox try:

Set outFolder = outNs.GetDefaultFolder(olFolderInbox).Folders("Saurabh")

Please use CODE tags when posting VBA code.

I am trying to define the folder name as string by referring the folder name from a worksheet cell but it's not working. can someone advise what could be going wrong over here...

Public Sub Extract_Outlook_Email_Attachments()

    Dim OutlookOpened As Boolean
    Dim outApp As Outlook.Application
    Dim outNs As Outlook.Namespace
    Dim outFolder As Outlook.MAPIFolder
    Dim outAttachment As Outlook.Attachment
    Dim outItem As Object
    Dim outMailItem As Outlook.MailItem
    Dim inputDate As String, subjectFilter As String
    Dim saveInFolder As String
   [B] Dim OutlookPersonalFolder As String[/B]
    
    [B]OutlookPersonalFolder = ThisWorkbook.Sheets(Sheet1).Range (E4).value[/B]



    saveInFolder = "C:\path\to\folder\"                                 'CHANGE FOLDER PATH AS NEEDED
    If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
    
    inputDate = InputBox("Enter date to filter the email subject", "Extract Outlook email attachments")
    If inputDate = "" Then Exit Sub
    
    subjectFilter = "Daily activities: " & Format(inputDate, "dd/mm/yyyy")
    
    'Get or create Outlook object and make sure it exists before continuing
    
    OutlookOpened = False
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set outApp = New Outlook.Application
        OutlookOpened = True
    End If
    On Error GoTo 0
    
    If outApp Is Nothing Then
        MsgBox "Cannot start Outlook.", vbExclamation
        Exit Sub
    End If
    
    Set outNs = outApp.GetNamespace("MAPI")
    
    Set outFolder = outNs.GetDefaultFolder(olFolderInbox).Folders([B]OutlookPersonalFolder[/B]) 'CHANGE FOLDER AS NEEDED
    'Set outFolder = outNs.PickFolder                                   'OR USER SELECTS FOLDER


    If Not outFolder Is Nothing Then
        For Each outItem In outFolder.Items
            If outItem.Class = Outlook.OlObjectClass.olMail Then
                Set outMailItem = outItem
                If outMailItem.Subject = subjectFilter Then
                    Debug.Print outMailItem.Subject
                    For Each outAttachment In outMailItem.Attachments
                        outAttachment.SaveAsFile saveInFolder & outAttachment.Filename
                    Next
                End If
            End If
        Next
    End If


    If OutlookOpened Then outApp.Quit
    
    Set outApp = Nothing


End Sub

Also if the filename of the attachment is same without date and I want to overwrite the file in the folder everyday, how could I achieve the same. and the mail subject line is also same everyday with no date in my case so how can i make sure that the macro downloads the attachment from the latest email or today's email only and if the today's email is missing then it shows the msgbox that the today's mail is not available and exits the macro.