在工作中,由于个人疏忽,经常会有发错邮件,或是邮件中遗漏附件等现象发生,为了预防这些问题,可以在发送邮件时利用相关的工具帮你自动检测出这些问题。
在网上搜了相关的问题,发现一段代码,但是代码里面有一些错误,导致无法正常使用,自己修改了一下:
主要实现了:
1、智能检测并提示附件遗漏
2、再次确认收件人有需要的可以拿去用,不会用的请留言。
使用方法已添加。
源代码:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim objContact As ContactItem
Dim cancel_Attach As Boolean
Dim intRes As Integer
Dim strMsg As String
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) = "附件"
intOldmsgstart = InStr(Item.Body, "-----Original Message-----")
If intOldmsgstart = 0 Then
strThismsg = Item.Body + " " + Item.Subject
Else
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
If Item.Attachments.Count = 0 Then
strMsg = "附件检测器:" & Chr(13) & Chr(10) & "此邮件中提及附件,是否遗漏添加附件?" & Chr(13) & Chr(10) & "是否发送?"
intRes = MsgBox(strMsg, vbYesNo + vbDefaultButton2 + vbExclamation, "Microsoft Outlook")
If intRes = vbNo Then
cancel_Attach = True
End If
End If
End If
Dim strTo As String
Dim strCC As String
Dim strBCC As String
strTo = ""
strCC = ""
strBCC = ""
If cancel_Attach = True Then
Cancel = True
Exit Sub
End If
If Item.MessageClass Like "IPM.TaskRequest*" Then
Set Item = Item.GetAssociatedTask(False)
End If
For Each objRecip In Item.Recipients
If LCase(objRecip.Address) Like "/o=*" Then
If objRecip.Type = olTo Then
strTo = strTo + objRecip.Name
ElseIf objRecip.Type = olCC Then
strCC = strCC + objRecip.Name
ElseIf objRecip.Type = olBCC Then
strBCC = strBCC + objRecip.Name
End If
End If
Next
MSGText = "主题:「" & Item.Subject & "」" & _
vbCr & " 收信 : " & strTo & vbCr & " 抄送 : " & strCC & vbCr & " 密送 : " & strBCC & _
vbCr & vbCr & "是否发送?"
If MsgBox(MSGText, vbYesNo, "Microsoft Outlook") = vbNo Then
Cancel = True
End If
End Sub
使用方法:
工具栏添加开发工具
进入选项-> 自定义工具栏,确保开发工具被选中
添加代码
进入开发工具->Visual Basic,拷贝代码到文件
放开宏的启动权限
因为自己写的宏是没有数字证书的,所以需要调整宏的安全级别,不建议放到最低,使用提示即可。