Printing emails and attachments

Question

I adapted code found online to remove certain image files from multiple emails.

When I try to print the message body and the attachment after removing unwanted images I can't print it in correct order: message body email#1 and attachment email#1 --> message body email#2 and attachment email#2 and so on. The macro also prints more copies of the attachments left behind? I want to have only one copy of the mail item (message) and one copy of the attachment(s)

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