Forwarding email based on the attachment file type and specific text found on the attachment file name

[dreams]

Hi,

I am not very familiar with VBA codes. Normally I would get several type of files (refer below attached image) in the email attachments.

I wanted to forward that same email with the attachment file extension having ".RDD" and all the PDF attachments except the PDF file name having a text "Transmittal" in it.

Can you someone help me on this?

.

 

[dreams]

Hi

I could able to find out the following code from a website which only filtering PDF files. Can someone help me to re-write the below code to include ".RDD" file and the PDF file name doesn't contain the text "Transmittal"? it will be great help. Thank you.

Sub ForwardEmailwithPDFAttachmentsOnly()

        ' Send Completed Message to Accenture

        On Error Resume Next

        Dim oApp As Outlook.Application
        Dim objFolder As Outlook.MAPIFolder
        Set oApp = New Outlook.Application
        Set objNS = Application.GetNamespace("MAPI")
        Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
        Dim oEmail As Outlook.MailItem
        Dim strFile As String
        Dim sFileType As String
        Dim bk, fg As Integer

        'Require that this procedure be called only when a message is selected
        If Application.ActiveExplorer.Selection.Count = 0 Then
            Exit Sub
        End If

        For Each objItem In Application.ActiveExplorer.Selection
            If objFolder.DefaultItemType = olMailItem Then
                If objItem.Class = olMail Then
                    Response = MsgBox("Forward message (" + Item.Subject + ") to Appended Subject")

                    Set myforward = objItem.Forward
                    myforward.Display

                    bk = myforward.Attachments.Count
                    fg = 1
                    For i = 1 To bk
                        If InStr(LCase(myforward.Attachments(fg).FileName), ".pdf") = 0 Then
                            myforward.Attachments(fg).Delete
                            Else: fg = fg + 1
                        End If
                    Next i

                    End If
            End If
        Next

        End Sub