Macro to select several emails, hit print, print emails and attachments.

[taylorsm]

I found this online that I think will work, but I am unable to make it work.




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

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder

Set Ns = Application.GetNamespace("MAPI")
Set Folder = Ns.GetDefaultFolder(olFolderInbox)
Set Items = Folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
PrintAttachments Item
End If
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
On Error Resume Next
Dim colAtts As Outlook.Attachments
Dim oAtt As Outlook.Attachment
Dim sFile As String
Dim sDirectory As String
Dim sFileType As String

sDirectory = "D:\Attachments"

Set colAtts = oMail.Attachments

If colAtts.Count Then
For Each oAtt In colAtts

sFileType = LCase$(right$(oAtt.FileName, 4))

Select Case sFileType
Case ".xls", ".doc", ".pdf"
sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If End Sub


I receive a compile error, only valid in object module and the "Private WithEvents Items As Outlook.Items" is red.

[gmayor]

That code appears to be old and written before XML format files and before Windows security was beefed up. I think the following is a closer approximation of what you are trying to do, but Windows security will rightly conspire against the opening of documents from the internet, and if there are macros in the documents here will be further problems. It might help to make your folder a trusted folder, but should you be trusting material in attachments to e-mail messages? I would treat this with extreme caution.


Option Explicit

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

Public Sub PrintSelectedMessageAttachments()
Dim olItem As Object
For Each olItem In Application.ActiveExplorer.Selection
If TypeOf olItem Is Outlook.MailItem Then
olItem.PrintOut 'Print the message
PrintAttachments olItem 'attempt to print the attachments
End If
Next olItem
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
Dim colAtts As Outlook.Attachments
Dim oAtt As Outlook.Attachment
Dim sFile As String
Dim sDirectory As String
Dim sFileType As String
On Error Resume Next
sDirectory = "D:\Attachments\" 'Folder must exist
Set colAtts = oMail.Attachments
If colAtts.Count Then
For Each oAtt In colAtts
sFileType = LCase$(Right$(oAtt.fileName, 4))
Select Case sFileType
Case ".xls", "xlsx", ".doc", "docx", ".pdf"
sFile = sDirectory & oAtt.fileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
End Sub