Solved: Automatically save and print attachments

[eddyp]

Hi all,

Im new here and I cant get the code working what I got from this site (from killian) to Automatically save and print attachments from outlook. vbaexpress.com/kb/getarticle.php?kb_id=522

When I drop a mail with attachment in the Temp outlook folder I get a “Compile error: expected user-defined type, not project.” @ line: Sub TargetFolderItems_ItemAdd(ByVal Item As Object)

'########################################################################## #####
'### 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
I try to get this working on office 2003 and now on 2007. I send this to a friend with 2007 and it worked but not on my system

Thanks, Eduard

Below the complete code.
'########################################################################## #####
'### Module level Declarations
'expose the items in the target folder to events
Option Explicit
DimWithEvents TargetFolderItems As Items
'set the string constant for the path to save attachments
Const FILE_PATH AsString = "C:\Temp\"

'########################################################################## #####
'### this is the Application_Startup event code in the ThisOutlookSession module
PrivateSub 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 AsObject)
'when a new item is added to our "watched folder" we can process it
Dim olAtt As Attachment
Dim i AsInteger

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)
EndIf
Next
EndIf

Set olAtt = Nothing

End Sub

'########################################################################## #####
'### this is the Application_Quit event code in the ThisOutlookSession module
PrivateSub Application_Quit()

Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing

End Sub

'########################################################################## #####
'### print routine
Sub PrintAtt(fFullPath AsString)

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

How to use:

1. From Outlook, open the VBEditor (Alt+F11)
2. Add a reference to the "Microsoft Excel <your version number> Object Library fron Tools>References
3. Paste the code into the ThisOutlookSession module
4. Create an Outlook folder named "Temp" in your Personal folders (or amend the code: Set TargetFolderItems to eqaul an existing folder)
5. Create a directory "C:\Temp" (or amend the constant: FILE_PATH to eqaul an existing folder)
6. Save the project
7. Restart Outlook (or run the routine "Application_Startup")

Test the code:

1. Move a mail item with some attachments into you target folder.
2. The attachments will be saved in your specified directory
3. Any Excel files will be printed

[Charlize]

[VBA]DimWithEvents TargetFolderItems As Items[/VBA]must be
[VBA]Public WithEvents TargetFolderItems As Items[/VBA]
Charlize

[eddyp]

Thanks Charlize,
i changed the line, save and restart outlook but still the same error.

[Charlize]

Why don't you try to create a temp folder inside the default inbox. Then you can use the default inbox as a reference where the items are moved to ?
In the application_startup() module you put this :
[vba]'*** check drag item to auto-print
'the folder = inbox
Public FolderWatch As Outlook.MAPIFolder
'subfolder of inbox
Public MySubFolderWatch As Outlook.MAPIFolder
'item placed in subfolder
Public WithEvents TargetFolderItems As Outlook.Items[/vba]
[vba]Set FolderWatch = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)[/vba]to refer to inbox. Then
[vba]Set MySubFolderWatch = FolderWatch.Folders("Auto-Print")[/vba] to refer to autoprint folder (which is a subfolder of inboxfolder) and for the items you put this
[vba]Set TargetFolderItems = MySubFolderWatch.Items[/vba]

So that you can use the rest of the routine you already have - TargetFolderItems_ItemAdd(ByVal item As Object) -.

Charlize

[eddyp]

i found a few typo's and now im getting i 2 steps further and one back ;-)
i changed Dim olAtt As Attachment to Dim olAtt As Attachments.

now the next error is: run-time error "13": type mismatch

If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)

[JP2112]

It should be Dim olAtt As Attachment, since your Set statement is referencing one particular attachment.

I notice that there are few spaces missing in the code, i.e. you have 'AsString' instead of 'As String', and so on. The original code from the KB article doesn't appear this way, so I can't tell if it's because of the way you're pasting it, or if you've actually tried to use it this way.

[eddyp]

thanks JP. this will do the job.