none
Remove just certain attachments from Multiple Highlighted emails RRS feed

  • Question

  • Hi everyone!

    I need to find a solution that can be placed under a 1 button macro, that can remove specific attachments with certain file extensions.  At present I am doing the following:

    1) Using the OUTLOOK search term ext: xxxx (xxxx being the file extension) I am being shown all emails that contains a given file extension attachment.  I can then order this filter by date to get any emails over a given age.

    2) I already have a Macro that, if I highlight multiple emails, it will remove ALL attachments from those emails. 

    My problem is, there may be other file extension attachments on these emails that should not be deleted.

    For example: Searching ext:xlsx will filter on emails with XLSX attachments, but these emails could also have PDFs or CSVs attached. 

    Is there an element of VBA code I can use to just focus on a specific file extension, so if I just want all XLSX attachments from highlighted emails removed, it can do so and leave other attachments alone?

    Below I have pasted the Macro code I am currently using that removes ALL attachments.  Can this be modded to just focus on a given file type?  Even if I have a macro just for XLXS and another for CSV for example, that would be fine.

    Public Sub ReplaceAttachmentsToLink()
    Dim objApp As Outlook.Application
    Dim aMail As Outlook.MailItem 'Object
    Dim oAttachments As Outlook.Attachments
    Dim oSelection As Outlook.Selection
    Dim i As Long
    Dim iCount As Long
    Dim sFile As String
    Dim sFolderPath As String
    Dim sDeletedFiles As String
      
        ' Get the path to your My Documents folder
        sFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
        On Error Resume Next
      
        ' Instantiate an Outlook Application object.
        Set objApp = CreateObject("Outlook.Application")
      
        ' Get the collection of selected objects.
        Set oSelection = objApp.ActiveExplorer.Selection
      
        ' Set the Attachment folder.
        sFolderPath = sFolderPath & "\OLAttachments"
      
         
        ' Check each selected item for attachments. If attachments exist,
        ' save them to the Temp folder and strip them from the item.
        For Each aMail In oSelection
      
        ' This code only strips attachments from mail items.
        ' If aMail.class=olMail Then
        ' Get the Attachments collection of the item.
        Set oAttachments = aMail.Attachments
        iCount = oAttachments.Count
          
            
        If iCount > 0 Then
          
            ' We need to use a count down loop for removing items
            ' from a collection. Otherwise, the loop counter gets
            ' confused and only every other item is removed.
              
            For i = iCount To 1 Step -1
              
                ' Save attachment before deleting from item.
                ' Get the file name.
                sFile = oAttachments.Item(i).FileName
                  
                ' Combine with the path to the Temp folder.
                sFile = sFolderPath & "\" & sFile
                  
                ' Save the attachment as a file.
                oAttachments.Item(i).SaveAsFile sFile
                  
                ' Delete the attachment.
                oAttachments.Item(i).Delete
                  
                'write the save as path to a string to add to the message
                'check for html and use html tags in link
                If aMail.BodyFormat <> olFormatHTML Then
                    sDeletedFiles = sDeletedFiles & vbCrLf & "<file://" & sFile & ">"
                Else
                    sDeletedFiles = sDeletedFiles & "<br>" & "<a href='file://" & _
                    sFile & "'>" & sFile & "</a>"
                End If
                  
                              
            Next i
            'End If
                  
           ' Adds the filename string to the message body and save it
           ' Check for HTML body
           If aMail.BodyFormat <> olFormatHTML Then
               aMail.Body = aMail.Body & vbCrLf & _
               "The file(s) were saved to " & sDeletedFiles
           Else
               aMail.HTMLBody = aMail.HTMLBody & "<p>" & _
               "The file(s) were saved to " & sDeletedFiles & "</p>"
           End If
            
           aMail.Save
           'sets the attachment path to nothing before it moves on to the next message.
           sDeletedFiles = ""
         
           End If
        Next 'end aMail
          
    ExitSub:
      
    Set oAttachments = Nothing
    Set aMail = Nothing
    Set oSelection = Nothing
    Set objApp = Nothing

    EndSub

    Many thanks in advance

    Gary

    Thursday, October 12, 2017 9:46 AM

All replies

  • Change the code to parse Attachment.FileName for the extensions on which you want it to operate.
    Thursday, October 12, 2017 12:07 PM
  • Hi Gary Finlay,

    below is the modified code that only delete the .xlsx file attachments.

    Public Sub ReplaceAttachmentsToLink()
    
    Dim objApp As Outlook.Application
    
    Dim aMail As Outlook.MailItem  'Object
    
    Dim oAttachments As Outlook.Attachments
    
    Dim oSelection As Outlook.Selection
    
    Dim i As Long
    
    Dim iCount As Long
    
    Dim sFile As String
    
    Dim sFolderPath As String
    
    Dim sDeletedFiles, strTestString As String
    
      
    
        ' Get the path to your My Documents folder
    
        sFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
    
        On Error Resume Next
    
      
    
        ' Instantiate an Outlook Application object.
    
        Set objApp = CreateObject("Outlook.Application")
    
      
    
        ' Get the collection of selected objects.
    
        Set oSelection = objApp.ActiveExplorer.Selection
    
      
    
        ' Set the Attachment folder.
    
        sFolderPath = sFolderPath & "\OLAttachments"
    
      
    
         
    
        ' Check each selected item for attachments. If attachments exist,
    
        ' save them to the Temp folder and strip them from the item.
    
        For Each aMail In oSelection
    
      
    
        ' This code only strips attachments from mail items.
    
        ' If aMail.class=olMail Then
    
        ' Get the Attachments collection of the item.
    
        Set oAttachments = aMail.Attachments
    
        iCount = oAttachments.Count
    
          
    
            
    
        If iCount > 0 Then
    
          
    
            ' We need to use a count down loop for removing items
    
            ' from a collection. Otherwise, the loop counter gets
    
            ' confused and only every other item is removed.
    
              
    
            For i = iCount To 1 Step -1
    
              
    
                ' Save attachment before deleting from item.
    
                ' Get the file name.
    
                sFile = oAttachments.Item(i).FileName
    
                  
    
                ' Combine with the path to the Temp folder.
    
                sFile = sFolderPath & "\" & sFile
    
                  strTestString = "." & Right(oAttachments.Item(i).FileName, Len(oAttachments.Item(i).FileName) - InStrRev(oAttachments.Item(i).FileName, "."))
                
                If (strTestString = ".xlsx") Then
                
                ' Save the attachment as a file.
    
                oAttachments.Item(i).SaveAsFile sFile
    
                  
    
                ' Delete the attachment.
    
                oAttachments.Item(i).Delete
    
                  
    
                'write the save as path to a string to add to the message
    
                'check for html and use html tags in link
    
                If aMail.BodyFormat <> olFormatHTML Then
    
                    sDeletedFiles = sDeletedFiles & vbCrLf & "<file://" & sFile & ">"
    
                Else
    
                    sDeletedFiles = sDeletedFiles & "<br>" & "<a href='file://" & sFile & "'>" & sFile & "</a>"
    
                End If
            Else
            End If
                  
    
                              
    
            Next i
    
            'End If
    
                  
    
           ' Adds the filename string to the message body and save it
    
           ' Check for HTML body
    
           If aMail.BodyFormat <> olFormatHTML Then
    
               aMail.Body = aMail.Body & vbCrLf & "The file(s) were saved to " & sDeletedFiles
    
           Else
    
               aMail.HTMLBody = aMail.HTMLBody & "<p>" & "The file(s) were saved to " & sDeletedFiles & "</p>"
    
           End If
    
            
    
           aMail.Save
    
           'sets the attachment path to nothing before it moves on to the next message.
    
           sDeletedFiles = ""
    
         
    
           End If
    
        Next 'end aMail
    
          
    
    ExitSub:
    
      
    
    Set oAttachments = Nothing
    
    Set aMail = Nothing
    
    Set oSelection = Nothing
    
    Set objApp = Nothing
    
    
    End Sub
    
    
    

    if you want to check other type of file or multiple file types then you need to make changes in the if condition below in code above.

      If (strTestString = ".xlsx") Then
     

    for different file type you can change the extension.

    for checking multiple type of file you can add "or" with other condition.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Friday, October 13, 2017 5:45 AM
    Moderator
  • Hi Gary Finlay,

    is your issue is solved now?

    I find that after creating this thread, you did not done any follow up.

    so if your issue is solve then I suggest you to post the solution and mark it as an answer.

    if your issue is still pending then I suggest you to refer the suggestions given by community members.

    it may help you to solve your issue.

    if then also you have any further question then let us know about that.

    We will try to provide further suggestions to solve the issue.

    thanks for your understanding.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, November 1, 2017 6:41 AM
    Moderator