jayben
04-20-2008, 11:18 AM
Hey everyone,
Can someone help me out as i'm going crazy here with some Outlook VBA Code..I have put together code that checks a folder for .zip files and copys them to a folder on my PC called C:\Output.
The only problem is that the e-mails originally arrive in the INBOX and I want to somehow copy these e-mails to the EXTRACTOR folder based on criteria including e-mail address and zip file attachments, and then perform the code to copy the attachments to C:\Output. The main reason is because I can't get Outlook rules and alerts to work and even when I manually run the rules and alerts the code below will not work. Therefore i'm thinking i need to incorporate the email movements from INBOX to EXTRACTOR into this code
Can someone help me please. Thanks The code is below:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''
'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("ARC Charts").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
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''
'EXIT CODE
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''
Private Sub Application_Quit()
Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing
End Sub
Can someone help me out as i'm going crazy here with some Outlook VBA Code..I have put together code that checks a folder for .zip files and copys them to a folder on my PC called C:\Output.
The only problem is that the e-mails originally arrive in the INBOX and I want to somehow copy these e-mails to the EXTRACTOR folder based on criteria including e-mail address and zip file attachments, and then perform the code to copy the attachments to C:\Output. The main reason is because I can't get Outlook rules and alerts to work and even when I manually run the rules and alerts the code below will not work. Therefore i'm thinking i need to incorporate the email movements from INBOX to EXTRACTOR into this code
Can someone help me please. Thanks The code is below:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''
'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("ARC Charts").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
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''
'EXIT CODE
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''
Private Sub Application_Quit()
Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing
End Sub