一个Outlook宏写的小程序，献给象我一样粗心大意的人

lee_hirisun

最近经常有这样的事情出现：Email已经发出去了，却发现附件没有加上，于是再补上一个Email。

不得已写了下面这个小程序，可以用在Outlook上面。在Email发送的时候，他会检查标题和正文里面有没有“附件”两个字，如果有这两个字，却又没有附件，就会出现提示。

最近用了这个东西，还是不错的，预防了不少事故的发生。谨在此献给象我一样粗心的人，希望大家喜欢。

代码如下：


''''''''''''''''''''''''''''''''''''''''''''
'发送Email的时候，会触发这个过程
'这段代码一定要写在发送Email的响应过程中
''''''''''''''''''''''''''''''''''''''''''''
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    On Error Resume Next
    Dim message As Outlook.MailItem
    Set message = Item
   
    If Not CheckAttachment(message) Then
        Cancel = True
        Exit Sub
    End If
End Sub

调用下面这个函数，检查是否应该有附件：


''''''''''''''''''''''''''''''''''''''''''''''
'检查标题或者正文里“附件”字样，是否可以发送附件？
''''''''''''''''''''''''''''''''''''''''''''''
Private Function CheckAttachment(message As Outlook.MailItem) As Boolean
    CheckAttachment = True
    If (message.Attachments.Count = 0 And _
            (InStr(message, "附件") > 0 Or InStr(message.Body, "附件") > 0)) Then
        Dim answer As VbMsgBoxResult
        answer = MsgBox("没有附件, 是否继续发送?", vbYesNo + vbQuestion, "Microsoft Office Outlook")
        If answer = vbNo Then
            CheckAttachment = False
        Else
            CheckAttachment = True
        End If
    End If
End Function

要运行这个宏，可能要改变Outlook的宏安全设置。