Solved: Printing attachements using a script in a rule

[Charlize]

This thing processes pdf's and doc's for unread items in the inbox folder (I used Internet Explorer to view the pdf's and control it through vba because I had no luck with Adobe.). Afterwards the items are marked read. Hope this will get you started.

[vba]Sub SaveAttachments()
Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim avDate() As String
Dim vDate As String
Dim i As Long

Const myPath As String = "C:\Data\Bijlagen\"

ReDim Preserve avDate(3)

Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = myOlapp.GetNamespace("MAPI")
'This is the default inbox folder
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
'Set myFolder = myFolder.Folders("This is the folder you want to process")

i = CountFiles(myPath)

For Each myItem In myFolder.Items
If myItem.UnRead = True Then
avDate = Split(CStr(myItem.ReceivedTime), "/")
'constructing date to be yyyy-m(m)-d(d)
'3rd value of array avDate is the year (for me). It could be
'different for you.
vDate = Mid(avDate(2), 1, 4) & "-" & avDate(1) & "-" & avDate(0)
If myItem.Attachments.Count <> 0 Then
For Each myAttachment In myItem.Attachments
If UCase(Right(myAttachment.FileName, 3)) = "DOC" Then
i = i + 1
myAttachment.SaveAsFile (myPath & vDate & " - " & i & " - " & _
myAttachment.FileName)
Printatt (myPath & vDate & " - " & i & " - " & myAttachment.FileName)
End If
If UCase(Right(myAttachment.FileName, 3)) = "PDF" Then
i = i + 1
myAttachment.SaveAsFile (myPath & vDate & " - " & i & " - " & _
myAttachment.FileName)
Printatt (myPath & vDate & " - " & i & " - " & myAttachment.FileName)
End If
Next
myItem.UnRead = False
End If
End If
Next
End Sub
Sub Printatt(what_to_print As String)
Select Case UCase(Right(what_to_print, 3))
Case "DOC"
Dim vWord As Object
Dim vWDoc As Object
Set vWord = CreateObject("Word.Application")
Set vWDoc = vWord.documents.Open(what_to_print)
vWord.Visible = True
vWDoc.PrintOut
AppActivate "Outlook"
'form with label to inform to press on button when printing of
'document is finished
'commandbutton of form just closes form with unload me
UFProgress.Show
vWDoc.Close False
Set vWDoc = Nothing
vWord.Application.Quit False
Set vWord = Nothing
Case "PDF"
'using internet explorer to view pdf's
Dim sUrl As String
Dim ie As Object
Dim oDoc As Object
Dim vloop As Long
sUrl = what_to_print
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = False
ie.Navigate sUrl
Do
If ie.readystate = 4 Then
ie.Visible = True
Exit Do
Else
DoEvents
End If
Loop
Set oDoc = ie.document
oDoc.printall
For vloop = 1 To 1000
DoEvents
Next vloop
'there comes a message that we process with sendkeys
'not the best solution but for now it works
SendKeys "{TAB}"
For vloop = 1 To 1000
DoEvents
Next vloop
SendKeys "{ENTER}"
ie.Visible = False
ie.Quit
Set ie = Nothing
UFProgress.Show
End Select
End Sub

Function CountFiles(strPath As String) As Integer
Dim fso As Object
Dim fldr As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(strPath)
CountFiles = fldr.Files.Count
Set fldr = Nothing
Set fso = Nothing
End Function
[/vba]Copy and paste this code in a module and run 'SaveAttachments' to process the inbox.

Charlize