Hey everyone. I have this piece of code I use in VBA but looking at expanding as currently the code only works if I manually move items to the EXTRACT folder. Is there any way I can get new items to move from INBOX to EXTRACT folder if the messages contain a certain email address and zip file.. I can't figure out how I could add this to my code so it ensures that new items upon arrival will be moved to the EXTRACT folder and then the code below is performed. Any help is greatly appreciated. Thanks ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'DECLARATIONS ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Option Explicit Dim WithEvents TargetFolderItems As Items 'set the string constant for the path to save attachments Const FILE_PATH As String = "C:\INPUT\" ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'APPLICATION STARTUP CODE ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Application_Startup() Dim ns As Outlook.NameSpace Set ns = Application.GetNamespace("MAPI") Set TargetFolderItems = ns.Folders.Item("TEST").Folders.Item("Inbox").Folders.Item("EXTRACT").Items End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'WATCH FOLDER AND PERFORM ACTION IF NEW FILE EXISTS ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub TargetFolderItems_ItemAdd(ByVal Item As Object) 'when a new item is added to our "watched folder" we can process it Dim olAtt As Attachment Dim i As Integer If Item.Attachments.Count > 0 Then For i = 1 To Item.Attachments.Count Set olAtt = Item.Attachments(i) 'we only need ZIP\zip files If Right(olAtt.FileName, 3) = "ZIP" Or Right(olAtt.FileName, 3) = "zip" Then olAtt.SaveAsFile FILE_PATH & olAtt.FileName 'save the file Item.UnRead = False End If Next End If Set olAtt = Nothing ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'EXIT CODE ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Application_Quit() Dim ns As Outlook.NameSpace Set TargetFolderItems = Nothing Set ns = Nothing End Sub
Set up an ItemAdd handler for the Inbox and if the incoming message meets your criteria move it to the EXTRACT folder (or directly process the item from the Inbox folder). -- Ken Slovak [MVP - Outlook] http://www.slovaktech.com Author: Professional Programming Outlook 2007 Reminder Manager, Extended Reminders, Attachment Options http://www.slovaktech.com/products.htm wrote in message news:08a12e36-6901-4458-8e7b-a62137668aa9@m3g2000hsc.googlegroups.com... > Hey everyone. I have this piece of code I use in VBA but looking at > expanding as currently the code only works if I manually move items to > the EXTRACT folder. Is there any way I can get new items to move from > INBOX to EXTRACT folder if the messages contain a certain email > address and zip file.. > > I can't figure out how I could add this to my code so it ensures that > new items upon arrival will be moved to the EXTRACT folder and then > the code below is performed. Any help is greatly appreciated. Thanks > > ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > 'DECLARATIONS > ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > Option Explicit > Dim WithEvents TargetFolderItems As Items > 'set the string constant for the path to save attachments > Const FILE_PATH As String = "C:\INPUT\" > > ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > 'APPLICATION STARTUP CODE > ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > Private Sub Application_Startup() > Dim ns As Outlook.NameSpace > > Set ns = Application.GetNamespace("MAPI") > Set TargetFolderItems = > ns.Folders.Item("TEST").Folders.Item("Inbox").Folders.Item("EXTRACT").Items > > > End Sub > > ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > 'WATCH FOLDER AND PERFORM ACTION IF NEW FILE EXISTS > ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > Sub TargetFolderItems_ItemAdd(ByVal Item As Object) > 'when a new item is added to our "watched folder" we can process > it > Dim olAtt As Attachment > Dim i As Integer > > If Item.Attachments.Count > 0 Then > For i = 1 To Item.Attachments.Count > Set olAtt = Item.Attachments(i) > > 'we only need ZIP\zip files > If Right(olAtt.FileName, 3) = "ZIP" Or > Right(olAtt.FileName, 3) = "zip" Then > olAtt.SaveAsFile FILE_PATH & olAtt.FileName 'save the > file > Item.UnRead = False > End If > Next > End If > > Set olAtt = Nothing > > > ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > 'EXIT CODE > ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > Private Sub Application_Quit() > > Dim ns As Outlook.NameSpace > Set TargetFolderItems = Nothing > Set ns = Nothing > > End Sub >
