邮件无主题或附件规范提醒.docx

邮件无主题或附件规范提醒鉴于大家轮流着被批评发邮件没有主题的悲惨命运（夸张下(*_*) ），找到一个方式来帮助大家避免出现这样的问题。 1. 启动outlook，通过菜单栏的工具宏Visual Basic 编辑器，（如果不熟悉的话，直接按Alt+F11就好）进入VBA编辑画面； 2. 双击左边的ThisOutlookSession，如果看不到的话，可以如下图 打开工程资源管理器（直接按Ctrl+r也是可以的），这样就可以看到了； 将如下代码 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) If Trim(Item.Subject) = Then cancelSend = MsgBox(请填写主题后发送！, , 邮件主题提示) Cancel = True Exit Sub End If If ContainsAttachmentString(Item.body) Then If Item.Attachments.Count = 0 Then cancelSend = MsgBox(可能忘记粘贴附件 & vbNewLine & 你确定寄出去吗？, vbYesNo + vbExclamation + vbDefaultButton2, 忘记粘贴附件提示) = vbNo Cancel = cancelSend End If End IfEnd SubPrivate Function ContainsAttachmentString(mailBody As String) Dim attachmentSign attachmentSign = attachment|附件 ContainsAttachmentString = RegExpMatch(mailBody, attachmentSign) End FunctionFunction RegExpMatch(ByVal myString As String, ByVal pattern As String) Create objects. Dim objRegExp As Object Dim objMatch As Object Dim colMatches As Object Dim RetStr As String Create a regular expression object. Set objRegExp = CreateObject(vbscript.regexp) Set the pattern by using the Pattern property. objRegExp.pattern = pattern Set Case Insensitivity. objRegExp.IgnoreCase = True Set global applicability. objRegExp.Global = True Test whether the String can be compared. If (objRegExp.Test(myString) = True) Then Get the matches. Set colMatches = objRegExp.Execute(myString) Execute search. For Each objMatch In colMatches Iterate Matches collection. RetStr = RetStr & Match found at position RetStr = RetStr & objMatch.FirstIndex & . Match Value is RetStr = RetStr & objMatch.Value & . & vbCrLf Next Else RetStr = End If RegExpMatch = RetStr End Function拷贝进去保存，关闭即可，如下图： 1. 设置VBA项目的数字签名 通过开始所有程序Microsoft Office Microsoft Office 工具VBA 项目的数字签名，就可以如下图创建一个名称为我的VBA证书了。 1. 回到VBA编辑画面，在工具数字签名中如下选择刚才创建的数据签名。 至此，大功告成了！ 这样在你没有写主题而选择发送邮件的时候就会提醒你是否没有写主题或正文中出现“附件”二字而没