忘记帖附件？让Outlook自动提示

忘记帖附件？让Outlook自动提示

原文地址：.html

由于签名中的图片也算作是附件，在原文的基础上，将签名中的图片被算作附件这种情况也处理了一下。我用的是Outlook 2010。

　　今天回一封重要邮件时又忘了帖附件，实在是很失礼的行为啊……想到这种事情以前也发生过几次，就希望自己动手丰衣足食一下。在网上搜了一下，果然找到了一个不错的VBA， 按照自己的情况 改动了一下，加入了对复杂情况的识别功能，并加了注释。效果还不错，帖出来供有缘人使用。
　　P.S. 科研人员和白领还是用Outlook或者Foxmail收发邮件吧，尽量少用Web客户端，尽管我承认一些Web客户端做得很不错（如Gmail就带有附件提醒功能）。对于商务应用和其它正式场合，用Web收发邮件就像用Web上水木一样，感觉就像穿背心裤衩拖鞋出席正式酒宴一样。另外Outlook的确是一个现代人的好帮手，如果你有一台WM平台的智能手机又会编程的话就更加如虎添翼了。
　　原帖位于.html，更需要感谢的是代码的最初作者Dan Evans（dan&#uk）.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)' 只检查邮件类型If TypeName(Item) <> "MailItem" Then Exit SubDim intRet As IntegerDim strMsg As String' 空主题？If Item.Subject = "" ThenstrMsg = "您的邮件缺少主题，返回填写吗？" & vbCrLf & "没有主题的邮件可不礼貌哦～"intRet = MsgBox(strMsg, vbYesNo + vbExclamation, "缺少主题")If intRet = vbYes ThenCancel = TrueExit SubEnd IfEnd If' 忘了帖附件？Dim intRes As IntegerDim strThismsg As StringDim intOldmsgstart As IntegerDim sSearchStrings(2) As StringDim bFoundSearchstring As BooleanDim i As Integer' 指定提示邮件可能需要附件的词bFoundSearchstring = False' 英文邮件sSearchStrings(0) = "attach"sSearchStrings(1) = "enclose"' 中文邮件sSearchStrings(2) = "附件"' 对于转发和回复的邮件，不要到信末附的邮件原文进行搜索' 纯文本格式的原文信头是“Original Message”或“邮件原件”，但HTML格式的回复没有intOldmsgstart = InStr(Item.Body, "发件人:")' 如果在邮件国际选项中打开了“答复和转发时邮件头使用英语”，则应该搜索英文信头' intRes作为临时变量intRes = InStr(Item.Body, "From:")' 对于多次回复和转发又有多种语言的情况，总是选择最上一封If intRes > 0 ThenIf (intOldmsgstart = 0) Or (intOldmsgstart > 0 And intRes < intOldmsgstart) ThenintOldmsgstart = intResEnd IfEnd IfIf intOldmsgstart = 0 Then' 不是Re/Fw的邮件则搜索邮件全文和主题strThismsg = Item.Body + " " + Item.SubjectElse' 是Re/Fw的邮件则只搜索用户写的部分和邮件主题strThismsg = Left(Item.Body, intOldmsgstart) + " " + Item.SubjectEnd If' 搜索邮件正文（和主题）中所有可能提示邮件需要附件的词For i = LBound(sSearchStrings) To UBound(sSearchStrings)If InStr(LCase(strThismsg), sSearchStrings(i)) > 0 ThenbFoundSearchstring = TrueExit ForEnd IfNext iIf bFoundSearchstring Then' 下面的代码是将签名中的图片排除在附件之外，image001.jpg是我机器上签名里图片的文件名，请按实际情况调整Dim bSignature As BooleanFor Each attach In Item.AttachmentsIf attach.FileName = "image001.jpg" ThenbSignature = TrueEnd IfNextIf Item.Attachments.Count = 0 Or (Item.Attachments.Count = 1 And bSignature) ThenstrMsg = "您的邮件可能缺少附件！" & vbCrLf & "是否仍要发送？"intRet = MsgBox(strMsg, vbYesNo + vbDefaultButton2 + vbExclamation, "缺少附件")If intRet = vbNo ThenCancel = TrueExit SubEnd IfEnd IfEnd If
End Sub

以上代码在Outlook 2007下运行通过，2003应该也可以。
使用方法：
（1）打开Outlook；
（2）按Alt + F11打开VBA；
（3）点击左侧树状目录最下面的“ThisOutlookSession”，看到右边出现空白的编辑窗口；
（4）把上面的代码复制到编辑窗口，保存即可。不用重启Outlook.
如果不改变Outlook的默认宏安全性设置，重启之后宏就会被禁用，可以调低宏安全性解决这个问题（Outlook界面的“工具”->“宏”->“安全性”），但这样会使Outlook受到宏病毒的威胁。最好的办法是在Office工具里的“VBA项目数字证书”给自己发一个数字证书，再用这个证书给自己写的宏进行数字签名（在VBA界面下的“工具”->“数字签名”）。进行数字签名之后重启Outlook，Outlook会提示发现新的已签名的宏，再选择“信任该证书签署的宏”（大概是这名字）即可。这样自己写的宏不会再得到警告，其它的宏仍然会受警告，从而避免中毒。