Excel/VBA - Attach filtered file to displayed email and clear filters in the same macro?-CodePudding

I was able to get the VBA code for a macro working where running the macro would filter the active sheet down to a specified category, send an email with the filters intact, and then clear the filters.

I've run into trouble with company-wide registry settings where manually changing the settings to not auto-block sending emails from Excel automatically reverses after a few hours. Since I'm making this VBA script for multiple people to use and think it would be onerous to instruct them to manually change their registry settings every time they update the file, I figured it would be easier to just use "EmailItem.Display" instead of "EmailItem.Send" and have them just click "send" on the automatically generated email.

This method, however, seems to have the drawback of sending the attachment without the category filter, perhaps because Outlook auto-updates the attachment as long as both Outlook and Excel are open(?) and the macro clears the filter after generating the email and attachment. Here is the code:

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 = "[email protected]; [email protected]"
    'To cc an email address
EmailItem.CC = "[email protected]; [email protected]"
    'To BCC an email
'EmailItem.BCC = "[email protected]"
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

Using this code with "EmailItem.Send" and no other changes maintains the filters while "EmailItem.Display" does not; I have tested and verified this. I assume this is because sending the email/attachment happens sequentially before clearing the filters in the code, as was intended.

I know one possibility would be to exclude the "Clear Sort/Filter macro" section and put in a "clear filters" button in the workbook, but does anyone know a way I could maintain the filters in the email attachment of the file while still clearing the filters in the live file in the same macro?

Thanks!

CodePudding user response：

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.