Okay - After studying a bit I altered the code - problem is that I still can't print as expected. It does not print email#1 body and then email"1 attachment(s) and it stops in Acrobat Reader with a error message that the file cannot be found - anyone?
Option Explicit Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' 32 bit Installation Sub DeleteSpcificTypeOfAttachmentsAndPrint() 'Macro to loop through a selection of emails. The macro removes unwanted image files in the email body as well as attached image files 'The macro then prints the email and the attachments. Dim xSelection As Outlook.Selection Dim xItem As Object Dim xMailItem As Outlook.MailItem Dim xAttachment As Outlook.Attachment Dim xFiletype As String Dim xType As String Dim xFSO As Scripting.FileSystemObject Dim i As Integer Set xSelection = Outlook.Application.ActiveExplorer.Selection Set xFSO = New Scripting.FileSystemObject For Each xItem In xSelection 'loop through the selected items If xItem.Class = olMail Then Set xMailItem = xItem If xMailItem.Attachments.Count > 0 Then 'check number of attachments to mail For i = xMailItem.Attachments.Count To 1 Step -1 'loop through number of attachments Set xAttachment = xMailItem.Attachments.Item(i) 'variable xAttachment = each attachment name xFiletype = xFSO.GetExtensionName(xAttachment.FileName) 'get extension of each attachment Select Case xFiletype 'If file extension is equal to listings then delete attachment Case "jpg", "jpeg", "png", "gif", "tif", "emf", "wmf", "bmp", "cur", "wpg", "xml" xAttachment.Delete Case Else End Select Next i 'End inner loop removing graphics End If xMailItem.BodyFormat = olFormatPlain 'Set email body to plain text xMailItem.Save 'Save the edited mail item xMailItem.PrintOut 'Print the mail body AND attachment Sleep (1000) 'Wait 1 second before proceeding to next email in the inner loop End If Next 'Next mail in the selection of emails Set xMailItem = Nothing Set xFSO = Nothing End Sub




Reply With Quote
