Automatically saving an attachment to the Hard Drive Outlook 2007

[stuartmabe]

Hi All

I am looking for a way to automatically save any attached file(s) directly to a folder on my hard drive. I want just the attached file rather than the whole e-mail message to be saved in this directory.

I have seen something for previous versions of Outlook and was hoping that somebody can help.

Can anybody help?

Thanks in Advance
Stu

[TonyJollans]

What do you have for previous versions that doesn't work in 2007. AFAIK what used to work still should.

[stuartmabe]

Thanks for replying

I found this on another thread but its for Outlook 2002 and i can't get it working.....Any ideas??

'########################################################################## #####
'### 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("Temp").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

'if its an Excel file, pass the filepath to the print routine
If UCase(Right(olAtt.FileName, 3)) = "XLS" Then
PrintAtt (FILE_PATH & olAtt.FileName)
End If
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

[TonyJollans]

A quick look at this suggests it 'catches' e-mails when they are moved to a particular folder ("Temp"), not when they arrive. Is that what you want? And, if so (or even, if not), what have you done with the code?

[stuartmabe]

Hi Tony

Thanks for the reply

I had set up a rule in outlook to move e-mails with a certain text in the subject to be moved to a folder called temp in my inbox which will then move it to a folder called temp on my hard drive.

I have not really done anything major with the code.

Is it possible to get working this way?

Thanks Again
Stuart

[TonyJollans]

When I said "what have you done with the code" I meant how are you trying to use it.

It appears to work. What problems are you having?