Attach filtered file to displayed email then clear filter

Question

I can filter the active sheet to a specified category, send it as an attachment, then clear the filters.

Due to company registry settings, manually changing to not auto-block sending emails from Excel automatically reverses after a few hours.

It would be onerous to instruct users to manually change registry settings every time they update the file. It would be easier to use EmailItem.Display and have them click "send".

This has the drawback of sending the attachment without the category filter, perhaps because Outlook updates the attachment as long as both Outlook and Excel are open(?) and the macro clears the filter after generating the email and attachment.

Sub SendEmail_CATEGORY()

Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application

Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)

'SortFilter

    ActiveSheet.Range("$A$5:$CG$1933").AutoFilter Field:=3, Criteria1:="CATEGORY"
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "AR5:AR1933"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


EmailItem.To = "hello1@gmail.com; hello2@gmail.com"
    'To cc an email address
EmailItem.CC = "hello3@gmail.com; hello4@gmail.com"
    'To BCC an email
'EmailItem.BCC = "username@government.gov"
EmailItem.Subject = "Update to File: See filtered attachment"


'Code to attach current workbook to email

Source = ThisWorkbook.FullName
    'Defines "Source" as the current workbook (note the "Dim" line earlier in the code)
EmailItem.Attachments.Add Source
    'Attaches "Source," defined in prior line


'HTML code for email body

EmailItem.HTMLBody = "Hello," & "<br>" & "<br>" & "This is an email to inform you of an update to the Spreadsheet" & _
vbNewLine & "<br>" & "<br>" & _
"Regards," & "<br>" & _
"The Team"


EmailItem.Display
'EmailItem.Display to just pull up a draft without sending; EmailItem.Send to send email if permissions allow


'Clear Sort/Filter macro

ActiveSheet.Range("$A$5:$CG$1933").AutoFilter Field:=3
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "B5:B1933"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

EmailItem.Send maintains the filters in the attachment. I assume because sending happens before clearing the filters.

One possibility would be to exclude the "Clear Sort/Filter" and put in a "clear filters" button in the workbook, but how could I maintain the filters in the email attachment while still clearing the filters in the live file in the same macro?

Answer 1

First of all, use the SaveAs methods to get a copy of the file saved and then attach the file from the location saved. So, before getting the FullName property value of the Workbook class save your changes:

'Code to attach current workbook to email

ThisWorkbook.SaveAs filePath ' to save to a specific path 
EmailItem.Attachments.Add filePath

I assume this is because sending the email/attachment happens sequentially before clearing the filters in the code, as was intended.

Having a separate copy of the filtered workbook attached ca solve this problem.