Download Attachments

[vmjan02]

I have the code which will down load attachments.
But need to modify the code so that it will only download on a specify subject line attachments even if the mail is read or unread.
Subject is "Open & Closed 2020-11-05" it also has the date. so every time date will change

Don't want to create any rules on the outlook
Any Idea

Sub DownloadAttachmentFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object
    '~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath   '& Format(Date, "DD-MM-YYYY") & "-"
    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If
    '~~> Extract the attachment from the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        '~~> Check if the email actually has an attachment
        If oOlItm.Attachments.Count <> 0 Then
            For Each oOlAtch In oOlItm.Attachments
                '~~> Download the attachment
                oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
                Exit For
            Next
        Else
            MsgBox "The First item doesn't have an attachment"
        End If
        Exit For
    Next
 End Sub

 

[John_w]

Change the Restrict filter string (for the current date) to:

.Restrict("[Subject] = ""Open & Closed " & Format(Date, "YYYY-MM-DD") & """")

 

[vmjan02]

"[Subject] = ""Open & Closed " & Format(Date, "YYYY-MM-DD") & """"

did but it going to msgbox

oOlInb.Items.Restrict("[Subject] = ""Cisco ENCOs KPIs - Open & Closed" & Format(Date, "YYYY-MM-DD") & """").Count = 0 Then

 

[John_w]

Which is the correct subject start string? "Open & Closed" or "Cisco ENCOs KPIs - Open & Closed"?

Also, you've missed a space between "Closed" and the date in the latter. Try this:

oOlInb.Items.Restrict("[Subject] = ""Cisco ENCOs KPIs - Open & Closed " & Format(Date, "YYYY-MM-DD") & """").Count = 0 Then

 

[vmjan02]

Which is the correct subject start string? "Open & Closed" or "Cisco ENCOs KPIs - Open & Closed"?

Also, you've missed a space between "Closed" and the date in the latter. Try this:

oOlInb.Items.Restrict("[Subject] = ""Cisco ENCOs KPIs - Open & Closed " & Format(Date, "YYYY-MM-DD") & """").Count = 0 Then

Still its showing the msgbox "NO Unread Email In Inbox"

Sub DownloadAttachmentFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object
    '~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = ActiveWorkbook.Path & Format(Date, "DD-MM-YYYY") & "-"
    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[Subject] = ""Cisco ENCOs KPIs - Open & Closed " & Format(Date, "YYYY-MM-DD") & """").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If
    '~~> Extract the attachment from the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        '~~> Check if the email actually has an attachment
        If oOlItm.Attachments.Count <> 0 Then
            For Each oOlAtch In oOlItm.Attachments
                '~~> Download the attachment
                oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
                Exit For
            Next
        Else
            MsgBox "The First item doesn't have an attachment"
        End If
        Exit For
    Next
 End Sub

 

[John_w]

The code works for me. Make sure you have at least 1 email in the Inbox with the exact subject "Cisco ENCOs KPIs - Open & Closed 2020-11-11", without the quotes. Check for extra spaces - leading, trailing, etc.

You'll want to change the MsgBox prompt since the If statement is no longer checking for unread emails.

Also, I suspect the NewFileName = line should be:

NewFileName = ActiveWorkbook.Path & "\" & Format(Date, "DD-MM-YYYY") & "-"

 

[vmjan02]

Will give it a try