网上转载,仅供参考
经常为忘了写标题和贴附件而苦恼,今天开始不用了。。。
老大推荐了这个宏,很好很强大,只是存在几个Bug...
1.代码格式十分FT..提示用中文
2.邮件的回复、转发等内容不用检查
3.提示在前台而不是后台
4.取消发送不是将邮件保留到草稿箱。
操作如下:
a. 打开outlook
b. 按“Alt + F11” 键来打开VB Script,或者[工具]->[宏]->[Visual Basic 编辑器]
c. 点击左侧树状目录最下面的“ThisOutlookSession”,看到右边出现空白的编辑窗口
d. 把代码拷贝到编辑窗口,保存,退出VB Script编辑。
代码修改了如下:
重启失效的原因是需要修改outlook的“工具”-->“宏”-->“安全性”-->修改安全级别为中或者低
这样重启outlook的时候,才会提示你是否加载该宏,而不是直接就默认拒掉
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeName(Item) <> "MailItem" Then Exit Sub
Dim intRet As Integer
'CHECK FOR BLANK SUBJECT LINE
If Item.Subject = "" Then
intRet = MsgBox("警告:您的郵件缺少主題,請注意填寫" & vbNewLine, vbOKOnly + vbMsgBoxSetForeground + vbExclamation, "缺少主題")
If intRet = vbOK Then
Cancel = True
Exit Sub
End If
End If
'CHECK FOR FORGETTING ATTACHMENT
Dim intRes As Integer
Dim strMsg As String
Dim strThismsg As String
Dim intOldmsgstart As Integer
' Does not search for "Attach", but for all strings in an array that is defined here
Dim sSearchStrings(2) As String
Dim bFoundSearchstring As Boolean
Dim i As Integer
bFoundSearchstring = False
sSearchStrings(0) = "attach"
sSearchStrings(1) = "enclose"
sSearchStrings(2) = "附件"
' intOldmsgstart = InStr(Item.Body, "-----Original Message-----")
intOldmsgstart = InStr(Item.Body, "發件人:")
If intOldmsgstart = 0 Then
strThismsg = Item.Body + " " + Item.Subject
Else
strThismsg = Left(Item.Body, intOldmsgstart) + " " + Item.Subject
End If
' The above if/then/else will set strThismsg to be the text of this message only,excluding old/fwd/re msg
' if the original included message is mentioning an attachment, ignore that Also includes the subject line at the end of the strThismsg string
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
If Item.Attachments.Count = 0 Then
strMsg = "警告:您的郵件缺少附件,請注意添加" & vbNewLine & "確認是否發送?"
intRet = MsgBox(strMsg, vbYesNo + vbMsgBoxSetForeground + vbDefaultButton2 + vbExclamation, "缺少附件")
If intRet = vbNo Then
Cancel = True
Exit Sub
End If
End If
End If
End Sub