Hi,
I am using Oulook 2003 and found and implemented the code by Killian to automatically save attachments in mails moved to a specific folder. This works fine as long as I manually move the mail in outlook. As soon as I install a rule to do this for me, the save of the attachment is no longer executed. Any idea what is going wrong ?
In the description it is mentioned this should work with a rule also...
This is the code I use :
'########################################################################## #####
'### Module level Declarations
'expose the items in the target folder to events
Option Explicit
Dim WithEvents TargetFolderItems As Items
'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\Temp\"
'########################################################################## #####
'### this is the Application_Startup event code in the ThisOutlookSession module
Private Sub Application_Startup()
'some startup code to set our "event-sensitive" items collection
Dim ns As Outlook.NameSpace
'
Set ns = Application.GetNamespace("MAPI")
Set TargetFolderItems = ns.Folders.Item( _
"Personal Folders").Folders.Item("ELSO").Items
End Sub
'########################################################################## #####
'### this is the ItemAdd event code
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)
'save the attachment
olAtt.SaveAsFile FILE_PATH & olAtt.FileName
Next
End If
Set olAtt = Nothing
End Sub
'########################################################################## #####
'### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()
Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing
End Sub
'########################################################################## #####
'### print routine
Sub PrintAtt(fFullPath As String)
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
'in the background, create an instance of xl then open, print, quit
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open(fFullPath)
wb.PrintOut
xlApp.Quit
'tidy up
Set wb = Nothing
Set xlApp = Nothing
End Sub
I do not refer to the print routine for the moment.
The rule is quite simple and moves incoming mail from a certain address to the ELSO folder.
Another thing I tried out is to have this work under the Inbox instead of Personal Folders as I normally do not work with PF, but the Set TargetFolderItems does not seem to work on Inbox ? I receive run-time error '-1663827697(9cd7010f) : An object could not be found' when starting Outlook.
Thanks in advance,
Ingrid