We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Private WithEvents objInboxItems As Items Private Sub Application_Startup() Dim objNS As NameSpace Set objNS = Application.GetNamespace("MAPI") ' instantiate Items collections for folders we want to monitor Set objInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items Set MyInbox = objNS.GetDefaultFolder(olFolderInbox) Set objNS = Nothing End Sub Private Sub Application_Quit() ' disassociate global objects declared WithEvents Set objInboxItems = Nothing End Sub Private Sub objInboxItems_ItemAdd(ByVal Item As Object) Dim olItems As Items, _ olItem As Object, _ olMailItem As MailItem, _ olAttachmentItem As Attachment, _ strInvoice As String, _ strFileName As String Set olItems = objInboxItems.Restrict("[Unread] = True") For Each olItem In olItems If olItem.Class = olMail Then Set olMailItem = olItem 'Selected based on the subject you want to key on If InStr(1, olMailItem.Subject, "Eriksen | Invoice #", vbTextCompare) > 0 Then If olMailItem.Attachments.Count > 0 Then strInvoice = Right(olItem, 6) For Each olAttachmentItem In olMailItem.Attachments strFileName = "Eriksen_Invoice_" & strInvoice 'Change the path on the next line to the path you want to save your attachments in olAttachmentItem.SaveAsFile "H:\My Documents\3_Purchase_Card\TransactionsFY2016\Eriksen_Translations\" & strFileName & ".pdf" olItem.UnRead = False Next End If End If End If Next End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
|Setup Exchange Server on Huawei Mate9||6||24|
|Legit email goes into JUNK.||3||50|
|Outlook 2010: How to search sub-folders||3||65|
|MS Outlook for the Mac - Limit of emails to download from Hotmail account||4||61|