Consulting

Results 1 to 7 of 7

Thread: Delete specific att and forward message

  1. #1
    VBAX Newbie
    Joined
    Mar 2023
    Posts
    5
    Location

    Smile Delete specific att and forward message

    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

  2. #2
    VBAX Regular
    Joined
    May 2018
    Location
    Sydney
    Posts
    57
    Location
    Try and delete the attachment from the 'objForward' object instead of the 'xItem' object.

    Sub DelAttAndForward()    Dim xFileSystemObj, xShellApp As Object
        Dim xNameSpace, xNameSpaceItem, xItem As Object
        Dim xTempFldPath, xFilePath As String
        Dim xSelItems As Outlook.Selection
        Dim objForward As Outlook.MailItem
        Dim xAttachments As Outlook.Attachments
        Dim xAttachment 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 xSelItems = Outlook.ActiveExplorer.Selection
        Set xShellApp = CreateObject("Shell.Application")
        Set xNameSpace = xShellApp.NameSpace(0)
        Set myinspector = Application.ActiveInspector
        
        For Each xItem In xSelItems
            If xItem.Class = OlObjectClass.olMail Then
                Set xAttachments = objForward.Attachments ' Change this line
                Set objFSO = CreateObject("Scripting.FileSystemObject")
                
                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
                        xAttachment.Delete
                    End If
                Next
            End If
        Next
    
    
        Set Atmt = Nothing
        Set xItem = Nothing
        Set xNameSpaceItem = Nothing
        Set xNameSpace = Nothing
        Set xShellApp = Nothing
        Set xFileSystemObj = Nothing
    End Sub
    I hope this helps your issue.
    If you only ever do what you can , you'll only ever be what you are.

  3. #3
    The following when used as a script in conjunction with a rule will forward the message, without the unwanted attachment, on arrival. Test it with the test macro on a selected message.
    Sub DelAttAndForward(olItem As MailItem)
    'Graham Mayor - https://www.gmayor.com - Last updated - 15 Mar 2023 
    Dim olOutMail As Outlook.MailItem
    Dim sAddr As String
    Dim olAtt As Attachment
    Dim i As Long
    sAddr = "you@somewhere.com"        'the address you want the message forwarding to
        If olItem.Attachments.Count >= 2 Then
            For i = olItem.Attachments.Count To 1 Step -1
                If LCase(olItem.Attachments(i).FileName) Like "detailinfo*" Then
                    Set olOutMail = olItem.Forward
                    With olOutMail
                        .To = sAddr
                        .CC = ""
                        .BCC = ""
                        .Display        'Change to .Send after testing
                        For Each olAtt In olOutMail.Attachments
                            If olAtt.FileName Like "detailinfo*" Then
                                olAtt.Delete
                            End If
                        Next olAtt
                    End With
                    Exit For
                End If
            Next i
        End If
    lbl_Exit:
        Set olOutMail = Nothing
        Set olAtt = Nothing
        Exit Sub
    End Sub
    
    Sub TestMacro()
    Dim olMsg As MailItem
        'On Error Resume Next
        Select Case Outlook.Application.ActiveWindow.Class
            Case olInspector
                Set olMsg = ActiveInspector.currentItem
            Case olExplorer
                Set olMsg = Application.ActiveExplorer.Selection.Item(1)
        End Select
        DelAttAndForward olMsg
    lbl_Exit:
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    VBAX Newbie
    Joined
    Mar 2023
    Posts
    5
    Location
    Hello figure 4.2,
    Thank you for your answer. I tested it and it works fine now. Thank you! My vba knowledge is not enough to see this detail, was already working on it for two days. Your Great!

  5. #5
    VBAX Newbie
    Joined
    Mar 2023
    Posts
    5
    Location
    Hi Gmayor,

    Thanks for your answer, I ll try it later today.

  6. #6
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    Erka, Welcome to the VBAX forum. If you have a solution to your query, please use the Thread Tools options and select "Mark this thread as Solved"
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  7. #7
    VBAX Newbie
    Joined
    Mar 2023
    Posts
    5
    Location
    Hi Aussibear, Thanks for the tip, I was searching for the 'is solved' option.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •