Question

我倾向于出于习惯，通过电子邮件发送固件文件以及我们不遵守的新政策要求。

如何在Outlook中生成弹出消息，提醒我将这些文件放在网络上而不是通过电子邮件发送，基于文件扩展名（通常是.S）？

Answer 1

这里的挑战是在使用Outlook UI时获取新项目（无标题电子邮件）的句柄，而不是通过VBA创建新项目。您需要首先将inspectors集合设置为用户定义的对象，该对象最终将包含新项目的父（新检查器）（无标题的电子邮件）。这可以通过应用程序级事件来完成，例如Startup。

然后，我们可以使用NewInspector事件来查看新检查员是否包含新消息;如果是这样，我们将它设置为我们在顶部定义的模块级MailItem对象。

现在，我们设置使用BeforeAttachment事件来检查附加文件的扩展名，如果扩展名是禁止的扩展名，它将提示消息并取消附加。

您仍然可以通过更好，更准确地进行扩展比较或将带有禁止扩展名的文件复制到您想要的位置来改进这一点，而无需手动执行此操作，甚至打开使用Windows资源管理器将文件放在那里所需的文件夹

放置代码： ALT + F11，双击ThisOutlookSession，粘贴代码并按CTRL + S保存

我希望这有帮助！：）

Option Explicit

Dim WithEvents myItem As Outlook.MailItem
Private WithEvents myOlInspectors As Outlook.Inspectors

Private Sub Application_Startup()
    Set myOlInspectors = Application.Inspectors
End Sub


Private Sub myOlInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
    Dim msg As Outlook.MailItem
    If Inspector.CurrentItem.Class = olMail Then
        Set msg = Inspector.CurrentItem

        If msg.Size = 0 Then
            'MsgBox "New message" 'uncomment to test this routine
            Set myItem = msg
        End If
    End If
End Sub

Private Sub myItem_BeforeAttachmentAdd(ByVal myAttachment As Attachment, Cancel As Boolean)
        Dim sExtension As String
        Dim sBannedExtension As String
        Dim arr As Variant

        sBannedExtension = "xlsx,frm,docx,jpg,png"

        arr = Split(myAttachment.FileName, ".")
        sExtension = arr(UBound(arr))

        If InStr(UCase(sBannedExtension), UCase(sExtension)) > 0 Then
            MsgBox "Sorry, you cannot send a file with a(n)" & sExtension & " extension as an attachment according to the new policy."
            Cancel = True
        End If
End Sub

如何在附加某些文件类型时在Outlook中创建警告消息？

1 个答案: