将过滤后的文件附加到显示的电子邮件，然后清除过滤器答案

【问题标题】：Attach filtered file to displayed email then clear filter将过滤后的文件附加到显示的电子邮件，然后清除过滤器
【发布时间】：2023-02-08 04:05:31
【问题描述】：

我可以将活动工作表过滤到指定类别，将其作为附件发送，然后清除过滤器。

由于公司注册表设置，手动更改为不自动阻止从 Excel 发送电子邮件会在几个小时后自动撤消。

指示用户在每次更新文件时手动更改注册表设置会很麻烦。使用EmailItem.Display 并让他们点击“发送”会更容易。

这有发送附件时没有类别过滤器的缺点，可能是因为只要 Outlook 和 Excel 都打开（？），Outlook 就会更新附件，并且宏会在生成电子邮件和附件后清除过滤器。

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 维护附件中的过滤器。我假设是因为发送发生在清除过滤器之前。

一种可能性是排除“清除排序/过滤器”并在工作簿中放入“清除过滤器”按钮，但是我如何在保持电子邮件附件中的过滤器的同时仍然清除同一宏中实时文件中的过滤器？

【问题讨论】：

也许您可以将临时文件夹中的文件“另存为”，然后将其作为独立文件附加以解决此问题。作为 OT，如果您找到了执行此操作的注册表，您可以使用类似 this 的方式在 VBA 中执行此操作，只需将密钥设置为常量字符串，附注：您可以评论此注册表项位置吗？另一种避免用户麻烦的方法如下：在显示邮件后使用发送命令，它不应该干扰，因为策略可能是避免在后台自动发送邮件
@Sgdva 我认为我无法通过 VBA 修复注册表问题——它位于 Computer\HKEY_CURRENT_USER\SOFTWARE\Policies\Microsoft\office\16.0\outlook\security 下，然后是“prompttosend”。不过，临时“saveas”是一个很好的解决方法，并且添加它允许我通过将“save”命令放在 attach/unfilter 命令之前来保留过滤后的版本。谢谢你！

标签： excel vba outlook email-attachments

【解决方案1】：

首先，使用 SaveAs 方法获取保存文件的副本，然后从保存位置附加文件。因此，在获取 Workbook 类的 FullName 属性值之前，请保存您的更改：

'Code to attach current workbook to email

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

我认为这是因为按预期发送电子邮件/附件是在清除代码中的过滤器之前按顺序发生的。

附上过滤后的工作簿的单独副本可以解决此问题。

【讨论】：