Print PDF attachments rcvd in inbox using VBA

[madamson86]

Hi All

I have found the below code that prints excel documents but I need to change it to print PDF documents. Does anyone know how I need to change the code to allow me to do this.

Cheers
Mike



'########################################################################## #####
'### 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 = "S:\test\"

'########################################################################## #####
'### this is the Application_Startup event code in the ThisOutlookSession module
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("Inbox").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

[madamson86]

Hi

I have worked this out now but would like to set the flag on the email that it has printed to red. How do I do this?

Cheers
Mike



'########################################################################## #####
'### 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 = "S:\Accounts (New)\test\"

'########################################################################## #####
'### this is the Application_Startup event code in the ThisOutlookSession module
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("Inbox").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
Dim Filename As String
Dim Mail As Outlook.MailItem
Dim obj As Outlook.MailItem
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
Filename = Right(olAtt.Filename, 3)
'if its an Excel file, pass the filepath to the print routine
If Filename = "pdf" Then
Shell """C:\Program Files\Adobe\reader 8.0\Reader\AcroRd32.exe"" /t """ & (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

[Charlize]

Item.FlagStatus = olFlagMarked
Item.FlagIcon = olRedFlagIcon
Item.Save
Add those lines where you check for a pdf file.

Charlize