Printing Multiple Attachments

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Several people have asked about Printing Multiple Attachments in Outlook
2003. In previous versions of Outlook, you could select all the attachments,
right-click and choose Print. However, Print is not a right-click choice
when you select multiple attachments in Outlook 2003.

We tried the Print Tools applications mentioned in another post and it has a
conflict with one of our third-party products.

Here is a macro that prints all the attachments in the selected email in the
inbox list, or all the attachments in the opened email message.

Disclaimer: Use totally at your own risk. I'm just offering this because
we needed it and maybe it will help someone out there. This is a combination
of solutions I found in various places on the internet - it is not all
written by me.

The only problem we have with this macro is if the email is in HTML format,
and there are multiple PDF attachments, not all the PDF attachments will
print unless printing to a postscript printer. But all Office attachments
print fine no matter what format the email message is in or what kind of
printer driver you use.

....and of course, since this is saved in the vbaproject.otm, it is not
easily passed along to multiple users.

But I hope this helps someone out there.

It saves the attachments into the c:\program files\microsoft office folder
and then uses the shellexecute command to print the file it saved.

MarieJ



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



Sub PrintAttachment()
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim strFile As String

'Set destination folder
myOrt = "C:\Program Files\Microsoft Office\"

On Error Resume Next

Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

For Each myItem In myOlSel
Set myAttachments = myItem.Attachments
If myAttachments.Count > 0 Then
For i = 1 To myAttachments.Count

myAttachments(i).SaveAsFile myOrt &
myAttachments(i).DisplayName
strFile = myOrt & myAttachments(i).DisplayName
ShellExecute 0&, "print", strFile, 0&, 0&, 0&
Next i
myItem.Save

End If
Next
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing



End Sub
 
Back
Top