Hi,

I have to forward e-mails every day, which always contain two attachments.
I always have to delete one of the attachments and only then can I forward it.


I'm looking for a macro that can do this automatically.


Of two attachments (pdf), one always starts with 'invoice_' followed by a random number. The second PDF always starts with 'detailinfo_' and a random number.
I am not a vba expert. My current code is based on the internet and my own modifications.
The code works except for one point, it removes detailinfo_*.pdf from the original message and not from the email to be sent. The original message should just stay as it is.

my code:
Sub DelAttAndForward()
'
Dim xFileSystemObj, xShellApp As Object
Dim xNameSpace, xNameSpaceItem, xItem As Object
Dim xTempFldPath, xFilePath As String
Dim xSelItems As Outlook.Selection
Dim xFWItems As Outlook.Selection
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim Atmt As Outlook.Attachment
Dim objFSO As Object
Dim sExt As String
Dim myinspector As Outlook.Inspector

    Set xFileSystemObj = CreateObject("Scripting.FileSystemObject")
    Set objForward = ActiveExplorer.Selection.Item(1).Forward
    objForward.Display

    Set xFWItems = Outlook.ActiveExplorer.Selection
    Set xShellApp = CreateObject("Shell.Application")
    Set xNameSpace = xShellApp.NameSpace(0)
    Set myinspector = Application.ActiveInspector
    Set myItem = myinspector.CurrentItem.Forward

    For Each xItem In xFWItems
        If xItem.Class = OlObjectClass.olMail Then
            Set xMailItem = xItem
            Set xAttachments = xMailItem.Attachments
            Set objFSO = CreateObject("Scripting.FileSystemObject")
        End If

                For Each xAttachment In xAttachments
                    xFilePath = xAttachment.FileName                  
                    If xFilePath Like "invoice_*.pdf" Then
                    xFilePath2 = xAttachment.FileName
                    objForward.Subject = ("[VRK] ") & xFilePath2
                    End If
                        If xFilePath Like "detailinfo_*.pdf" Then
                        Set objForward = Item.Forward
                        xAttachment.Delete
                        End If
                Next
        
    Next

    Set Atmt = Nothing
    Set xItem = Nothing
    Set xNameSpaceItem = Nothing
    Set xNameSpace = Nothing
    Set xShellApp = Nothing
    Set xFileSystemObj = Nothing

End Sub