with a lot of help from Killian posting this on
http://www.vbaexpress.com/kb/getarticle.php?kb_id=522
I used the following sollution for this problem
1. make a new map in outlook
2. make a rule to move specific mail with attachments to move to that folder
3. find selfcert.exe in the office directory and make a selfsigned
certificate (this is to prevent annoying macro security messages later)
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Option Explicit
Dim WithEvents TargetFolderItems As Items
'set the string constant for the path to save attachments make sure this
path excists
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
Dim Gebruikersnaam As String
Set ns = Application.GetNamespace("MAPI")
'This part makes sure the full path name of the outlook folder is taken
(including username) make sure this
'is too in your case
Uname= ns.CurrentUser
Set TargetFolderItems = ns.Folders.Item("Postbus - " &
Uname).Folders.Item("your folder").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 UCase(Right(olAtt.FileName, 3)) = "PDF" Then
PrintPdf (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 PrintPdf(fFullPath As String)
ShellExecute 0&, "print", fFullPath, 0&, 0&, 0&
End Sub
'################################################# ###############################
'################################################# ##############################
4. add from the menu Extra a digital signature to the macro you created
earlier
5. after starting outlook again you select allways trust this publisher
Any ideas about fixing the problem with printing multiple pdf attachments
that not all documents are printed.... perhaps a sleep somewhere?
(possible by making a seperate module with Declare Sub Sleep Lib "kernel32"
(ByVal dwMilliseconds As Long) in it)