忘記帖附件？讓Outlook自動提示

原文地址：http://blog.sina.com.cn/s/blog_660c623c0100timt.html

由於簽名中的圖片也算作是附件，在原文的基礎上，將簽名中的圖片被算作附件這種情況也處理了一下。我用的是Outlook 2010。

　　今天回一封重要郵件時又忘了帖附件，實在是很失禮的行爲啊……想到這種事情以前也發生過幾次，就希望自己動手豐衣足食一下。在網上搜了一下，果然找到了一個不錯的VBA，按照自己的情況改動了一下，加入了對複雜情況的識別功能，並加了註釋。效果還不錯，帖出來供有緣人使用。
　　P.S. 科研人員和白領還是用Outlook或者Foxmail收發郵件吧，儘量少用Web客戶端，儘管我承認一些Web客戶端做得很不錯（如Gmail就帶有附件提醒功能）。對於商務應用和其它正式場合，用Web收發郵件就像用Web上水木一樣，感覺就像穿背心褲衩拖鞋出席正式酒宴一樣。另外Outlook的確是一個現代人的好幫手，如果你有一臺WM平臺的智能手機又會編程的話就更加如虎添翼了。
　　原帖位於http://hi.baidu.com/ʫչ/blog/item/c7f8dff9d032d658242df275.html，更需要感謝的是代碼的最初作者Dan Evans（[email protected]）.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    ' 只檢查郵件類型
    If TypeName(Item) <> "MailItem" Then Exit Sub
   
    Dim intRet As Integer
    Dim strMsg As String
   
    ' 空主題？
    If Item.Subject = "" Then
        strMsg = "您的郵件缺少主題，返回填寫嗎？" & vbCrLf & "沒有主題的郵件可不禮貌哦～"
        intRet = MsgBox(strMsg, vbYesNo + vbExclamation, "缺少主題")
        If intRet = vbYes Then
            Cancel = True
            Exit Sub
        End If
    End If
   
    ' 忘了帖附件？
    Dim intRes As Integer
    Dim strThismsg As String
    Dim intOldmsgstart As Integer
   
    Dim sSearchStrings(2) As String
    Dim bFoundSearchstring As Boolean
    Dim 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 Then
        If (intOldmsgstart = 0) Or (intOldmsgstart > 0 And intRes < intOldmsgstart) Then
            intOldmsgstart = intRes
        End If
    End If
   
    If intOldmsgstart = 0 Then
        ' 不是Re/Fw的郵件則搜索郵件全文和主題
        strThismsg = Item.Body + " " + Item.Subject
    Else
        ' 是Re/Fw的郵件則只搜索用戶寫的部分和郵件主題
        strThismsg = Left(Item.Body, intOldmsgstart) + " " + Item.Subject
    End If
   
    ' 搜索郵件正文（和主題）中所有可能提示郵件需要附件的詞
    For i = LBound(sSearchStrings) To UBound(sSearchStrings)
        If InStr(LCase(strThismsg), sSearchStrings(i)) > 0 Then
            bFoundSearchstring = True
            Exit For
        End If
    Next i
   
    If bFoundSearchstring Then
        ' 下面的代碼是將簽名中的圖片排除在附件之外，image001.jpg是我機器上簽名裏圖片的文件名，請按實際情況調整
        Dim bSignature As Boolean
        
        For Each attach In Item.Attachments
            If attach.FileName = "image001.jpg" Then
                bSignature = True
            End If
        Next
        
        If Item.Attachments.Count = 0 Or (Item.Attachments.Count = 1 And bSignature) Then
            strMsg = "您的郵件可能缺少附件！" & vbCrLf & "是否仍要發送？"
            intRet = MsgBox(strMsg, vbYesNo + vbDefaultButton2 + vbExclamation, "缺少附件")
            If intRet = vbNo Then
                Cancel = True
                Exit Sub
            End If
        End If
        
    End If
End Sub

以上代碼在Outlook 2007下運行通過，2003應該也可以。
使用方法：
（1）打開Outlook；
（2）按Alt + F11打開VBA；
（3）點擊左側樹狀目錄最下面的“ThisOutlookSession”，看到右邊出現空白的編輯窗口；
（4）把上面的代碼複製到編輯窗口，保存即可。不用重啓Outlook.
如果不改變Outlook的默認宏安全性設置，重啓之後宏就會被禁用，可以調低宏安全性解決這個問題（Outlook界面的“工具”->“宏”->“安全性”），但這樣會使Outlook受到宏病毒的威脅。最好的辦法是在Office工具裏的“VBA項目數字證書”給自己發一個數字證書，再用這個證書給自己寫的宏進行數字簽名（在VBA界面下的“工具”->“數字簽名”）。進行數字簽名之後重啓Outlook，Outlook會提示發現新的已簽名的宏，再選擇“信任該證書籤署的宏”（大概是這名字）即可。這樣自己寫的宏不會再得到警告，其它的宏仍然會受警告，從而避免中毒。