> 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 >