避免outlook发信,忘记标题和附件

在outlook 2003中添加“空邮件标题”和“空附件”检查功能

 

 

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeName(Item) <> "MailItem" Then Exit Sub

Dim cancel_Subject As Boolean
Dim cancel_Attach As Boolean


'CHECK FOR BLANK SUBJECT LINE
If Item.Subject = "" Then
cancel_Subject = MsgBox("这个邮件没有主题." & vbNewLine & _
"你确认要发送吗?", _
vbYesNo + vbExclamation, "空主题") = vbNo
End If

If cancel_Subject = False Then
'CHECK FOR FORGETTING ATTACHMENT
Dim intRes As Integer
Dim strMsg As String
Dim strThismsg As String
Dim intOldmsgstart As Integer

' ADDED BY LS >>>
' - Does not search for "Attach", but for all strings in an array that is defined here
Dim sSearchStrings(1) As String
Dim bFoundSearchstring As Boolean
Dim i As Integer ' loop var for FOR-NEXT-loop
bFoundSearchstring = False

sSearchStrings(0) = "附件"
sSearchStrings(1) = "文档"

' ADDED BY LS <<<

intOldmsgstart = InStr(Item.Body, "本邮件及其附件含有华为公司的保密信息,仅限于发送给上面地址中列出的个人或群组。")
' intOldmsgstart is the location of where old/re/fwd/signature msg starts. Will be 0 if new msg

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
' IE if the original included message is mentioning an attachment, ignore that
' Also includes the subject line at the end of the strThismsg string

' ADDED BY LS >>>
For i = LBound(sSearchStrings) To UBound(sSearchStrings)
If InStr(LCase(strThismsg), sSearchStrings(i)) > 0 Then
bFoundSearchstring = True
Exit For
End If
Next i
' ADDED BY LS <<<

If bFoundSearchstring Then
If Item.Attachments.Count = 0 Then
strMsg = "附件检查:" & Chr(13) & Chr(10) & "你的邮件中提到附件, 但是你还没有上传附件." & Chr(13) & Chr(10) & "你确认要发送吗?"
intRes = MsgBox(strMsg, vbYesNo + vbDefaultButton2 + vbExclamation, "你忘记上传附件啦!")
If intRes = vbNo Then
' cancel send
cancel_Attach = True
End If
End If
End If
End If

If (cancel_Subject Or cancel_Attach) = True Then
Cancel = True
End If

End Sub


 

下面来简单介绍怎么用,或者说怎么嵌入到outlook中:
a. 打开outlook
b. 按“Alt + F11” 键来打开VB Script
c. 点击左侧树状目录最下面的“ThisOutlookSession”,看到右边出现空白的编辑窗口
d. 把代码拷贝到编辑窗口,保存,退出VB Script编辑。(不用重启Outlook)

就这么简单,自己写个email测试一下功能看看?能否看到提示窗口?

经过测试,在Outlook 2002/2003/2007上通过。

对于“Missing Attachment”功能,补充两句:这段代码是检查Email正文中的关键词:attach, enclose,来判断是否要求添加附件。根据自己需要,可以添加关键词,比如“附件”等等。代码中有:
Dim sSearchStrings(1) As String

sSearchStrings(0) = "附件"
sSearchStrings(1) = "文档"
如果要增加关键词,就相应增加sSearchStrings(1)中的数字(如果有N个关键词,就为N-1),然后在下面添加相应的关键词,如:
sSearchStrings(2) = "attach"

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值