Add text to email body after removing attachments-CodePudding

I have a current MS Outlook VBA Macro to remove all attachments from an email apart from attachments of one specific filetype (not my code, hobbled together from a few posts on here) and it works great.

    Dim objSelection As Outlook.Selection
    Dim i, n As Long
    Dim objMail As Outlook.MailItem
    Dim objAttachment As Outlook.Attachment
    Dim strFileType As String
 
    'Get the selected emails
    Set objSelection = Outlook.Application.ActiveExplorer.Selection
 
    'Process each email one by one
    For i = objSelection.Count To 1 Step -1
        If TypeOf objSelection(i) Is MailItem Then
           Set objMail = objSelection(i)
           If objMail.Attachments.Count > 0 Then
              For n = objMail.Attachments.Count To 1 Step -1
                  Set objAttachment = objMail.Attachments.Item(n)
                  'Get the attachment file type
                  strFileType = Right(objAttachment.FileName, Len(objAttachment.FileName) - InStr(1, objAttachment.FileName, "."))
                  'Leave 'obr' attachments, Delete all other types of attachments
                  Select Case strFileType
                         Case is <> "obr"
                              objAttachment.Delete
                         Case Else
                  End Select
              Next
              objMail.Save
           End If
         End If
    Next i
End Sub

However i've found i have a need to record what attachments were deleted, so i can search for the filenames and then recover the original email from the backup server. Therefore what i'm after is to insert the filenames of the deleted attachments into the emails they are deleted from.

I'm not concerned about the location, so the top is fine, something along the lines of:

<<Attachment deleted: attachment name.pdf>>

CodePudding user response：

Sub DelAtt()
    Dim objSelection As Outlook.Selection
    Dim i, n As Long
    Dim objMail As Outlook.MailItem
    Dim objAttachment As Outlook.Attachment
    Dim strFileType As String
    
    Dim del_att_list As String
 
    'Get the selected emails
    Set objSelection = Outlook.Application.ActiveExplorer.Selection
 
    'Process each email one by one
    For i = objSelection.Count To 1 Step -1
        If TypeOf objSelection(i) Is MailItem Then
           Set objMail = objSelection(i)
           If objMail.Attachments.Count > 0 Then
              For n = objMail.Attachments.Count To 1 Step -1
                  Set objAttachment = objMail.Attachments.Item(n)
                  'Get the attachment file type
                  strFileType = Right(objAttachment.FileName, Len(objAttachment.FileName) - InStrRev(objAttachment.FileName, ".")) ' InStrRev instead of InStr to find exactly the last dot
                  'Leave 'obr' attachments, Delete all other types of attachments
                  Select Case strFileType
                         Case Is <> "obr"
                            del_att_list = del_att_list & Replace("<<Attachment deleted: #>>", "#", objAttachment.FileName) & vbLf ' add filename to list of deleted attachments
                            objAttachment.Delete
                         Case Else
                  End Select
              Next
                If del_att_list <> "" Then  'smth was deleted
                    With objMail
                        .Body = del_att_list & vbLf & .Body ' add lines to the body top
                        .Save
                    End With
                End If
           End If
         End If
    Next i
End Sub

Before

After

CodePudding user response：

Keep in mind that you need to modify HTMLBody, not plain text Body - otherwise the formatting will be lost. And you cannot concatenate two HTML strings - you must merge the two: find the position of the <body substring, find the next > (this way you take care of the body tags with attributes) and insert your text after that.