在工作中,由于个人疏忽,经常会有发错邮件,或是邮件中遗漏附件等现象发生,为了预防这些问题,可以在发送邮件时利用相关的工具帮你自动检测出这些问题。
在网上搜了相关的问题,发现一段代码,但是代码里面有一些错误,导致无法正常使用,自己修改了一下:
主要实现了:
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

使用方法:

工具栏添加开发工具

进入选项-> 自定义工具栏,确保开发工具被选中
outlook_check1.png

添加代码

进入开发工具->Visual Basic,拷贝代码到文件
outlook_check2.png
outlook_check3.png

放开宏的启动权限

因为自己写的宏是没有数字证书的,所以需要调整宏的安全级别,不建议放到最低,使用提示即可。
outlook_check4.png

效果展示

outlook_check5.png
outlook_check6.png