Solved: Printing attachements using a script in a rule

[Neodubois]

Hello,

I am currently using Outlook 2003, on a daily basis I open mails in an inbox right click to print the attachment than move the mail to another folder.

I create a rule which will select the mails move them to the subfolder and apply a script

The rule works, but no printing happens, it seems some variables have not been defined.

this is what I created and tested


Sub CustomMailMessageRule(Item As Outlook.MailItem)
Dim Item As Object
Dim x As Attachments

For Each x In Item.Attachments
x.PrintOut
printAttachements = True
Next x
End Sub


I have no need to print the mail itself

Thanks in advance if anyone has a solution

(originally posted in French here (http://vbaexpress.com/forum/showthread.php?t=11973))

[Charlize]

What kind of documents needs to be printed ? Word, Excel ... something else ?

Charlize

[Neodubois]

Well actually most of them are tif some are pdf and rarely xls

And I use imaging to open the tif attachments

[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.

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
Copy and paste this code in a module and run 'SaveAttachments' to process the inbox.

Charlize

[Neodubois]

Many thanks for your help.

As I mentioned above in Outlook 2003 I don't have to open the attachment in order to print it, I just have to open the mail than right click on the attchment and select print, this works with all formats.

The solution you give opens each attachment than prints it, this is maybe why it can't print everything

I thought the code would have like 10 lines max

Will be using this for the time solves part of my problem but most attachments are tif.

[Neodubois]

Actually the same thing should happen as when you select several mails than right click and select print, only in that case it would print the mails also which I don't need.

[Neodubois]

Well I found the solution myself.

If any one is interested let me know I will than post the code

[DogStarr69]

Hey Neodubois, if you've got that solution I'd be so, so grateful...

Thanks