为outlook添加邮件发送的确认提示框

[隐藏]

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