参考资料邮件无主题或附件规范提醒.docx

邮件无主题或附件规范提醒鉴于大家轮流着被批评发邮件没有主题的悲惨命运（夸张下(*^__^*) ……），找到一个方式来帮助大家避免出现这样的问题。启动outlook，通过菜单栏的工具?宏?Visual Basic 编辑器，（如果不熟悉的话，直接按Alt+F11就好）进入VBA编辑画面；双击左边的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 If?End Sub?Private Function ContainsAttachmentString(mailBody As String)??? Dim attachmentSign??????? ??? attachmentSign = attachment|附件??? ContainsAttachmentString = RegExpMatch(mailBody, attachmentSign)??? End Function??Function RegExpMatch(ByValmyString As String, ByVal pattern As String)?? Create objects.?? Dim objRegExp As Object?? Dim objMatch As Object?? Dim colMatches As Object?? Dim RetStrAs 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 objMatchIncolMatches?? 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拷贝进去保存，关闭即可，如下图：设置VBA项目的数字签名通过开始?所有程序?Microsoft Office ?Microsoft Office 工具?VBA 项目的数字签名，就可以如下图创建一个名称为我的VBA证书了。回到VBA编辑画面，在工具?数字签名中如下选择刚才创建的数据签名。至