Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Const olFolderInbox As Integer = 6
- '~~> Path for the attachment
- Const AttachmentPath As String = "C:"
- 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
- Option Explicit
- Public Sub Example()
- '// Declare your Variables
- Dim olNs As Outlook.NameSpace
- Dim Inbox As Outlook.MAPIFolder
- Dim Items As Outlook.Items
- Dim Item As Outlook.MailItem
- Dim Atmt As Attachment
- Dim Filter As String
- Dim FilePath As String
- Dim AtmtName As String
- Dim i As Long
- '// Set Inbox Reference
- Set olNs = Application.GetNamespace("MAPI")
- Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
- FilePath = "C:Temp"
- Filter = "[attachment] = True And [Unread] = True"
- Set Items = Inbox.Items.Restrict(Filter)
- '// Loop through backwards
- For i = Items.Count To 1 Step -1
- Set Item = Items(i)
- DoEvents
- If Item.Class = olMail Then
- Debug.Print Item.Subject ' Immediate Window
- For Each Atmt In Item.Attachments
- AtmtName = FilePath & Atmt.FileName
- Atmt.SaveAsFile AtmtName
- Next
- End If
- Next
- Set Inbox = Nothing
- Set Items = Nothing
- Set Item = Nothing
- Set Atmt = Nothing
- Set olNs = Nothing
- End Sub
Add Comment
Please, Sign In to add comment