Guest User

Untitled

a guest
Jan 21st, 2018
90
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.36 KB | None | 0 0
  1. Const olFolderInbox As Integer = 6
  2. '~~> Path for the attachment
  3. Const AttachmentPath As String = "C:"
  4.  
  5. Sub DownloadAttachmentFirstUnreadEmail()
  6. Dim oOlAp As Object, oOlns As Object, oOlInb As Object
  7. Dim oOlItm As Object, oOlAtch As Object
  8.  
  9. '~~> New File Name for the attachment
  10. Dim NewFileName As String
  11. NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"
  12.  
  13. '~~> Get Outlook instance
  14. Set oOlAp = GetObject(, "Outlook.application")
  15. Set oOlns = oOlAp.GetNamespace("MAPI")
  16. Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
  17.  
  18. '~~> Check if there are any actual unread emails
  19. If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
  20. MsgBox "NO Unread Email In Inbox"
  21. Exit Sub
  22. End If
  23.  
  24. '~~> Extract the attachment from the 1st unread email
  25. For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
  26. '~~> Check if the email actually has an attachment
  27. If oOlItm.Attachments.Count <> 0 Then
  28. For Each oOlAtch In oOlItm.Attachments
  29. '~~> Download the attachment
  30. oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
  31. Exit For
  32. Next
  33. Else
  34. MsgBox "The First item doesn't have an attachment"
  35. End If
  36. Exit For
  37. Next
  38. End Sub
  39.  
  40. Option Explicit
  41. Public Sub Example()
  42. '// Declare your Variables
  43. Dim olNs As Outlook.NameSpace
  44. Dim Inbox As Outlook.MAPIFolder
  45. Dim Items As Outlook.Items
  46. Dim Item As Outlook.MailItem
  47. Dim Atmt As Attachment
  48. Dim Filter As String
  49. Dim FilePath As String
  50. Dim AtmtName As String
  51. Dim i As Long
  52.  
  53. '// Set Inbox Reference
  54. Set olNs = Application.GetNamespace("MAPI")
  55. Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
  56.  
  57. FilePath = "C:Temp"
  58. Filter = "[attachment] = True And [Unread] = True"
  59.  
  60. Set Items = Inbox.Items.Restrict(Filter)
  61.  
  62. '// Loop through backwards
  63. For i = Items.Count To 1 Step -1
  64. Set Item = Items(i)
  65.  
  66. DoEvents
  67.  
  68. If Item.Class = olMail Then
  69. Debug.Print Item.Subject ' Immediate Window
  70.  
  71. For Each Atmt In Item.Attachments
  72. AtmtName = FilePath & Atmt.FileName
  73. Atmt.SaveAsFile AtmtName
  74. Next
  75. End If
  76. Next
  77.  
  78. Set Inbox = Nothing
  79. Set Items = Nothing
  80. Set Item = Nothing
  81. Set Atmt = Nothing
  82. Set olNs = Nothing
  83. End Sub
Add Comment
Please, Sign In to add comment