outlook 发送邮件前提醒 宏

使用outlook发送邮件的时候，会由于某种原因发错人等等，在网上收了一些资料成一个宏，用于发送邮件之前的确认信息。

步骤如下：

1，  打开outlook，工具—》宏—》visual basic 编辑器

2，  即可打开编辑器，双击thisoutlooksession 打开一个代码编辑画面将如下代码copy进去即可。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim objRecip As Recipient
    Dim objContact As ContactItem
    Dim strExternal As String

    If Item.MessageClass Like "IPM.TaskRequest*" Then
        Set Item = Item.GetAssociatedTask(False)
    End If
    strExternal = ""
    For Each objRecip In Item.Recipients
        Set objContact = FindContactByAddress(objRecip.Address)
        If objContact Is Nothing Then
            If LCase(objRecip.Address) Like "/o=*" Then
                strExternal = strExternal & "内部发送" & objRecip.Name & vbCr
            Else
                strExternal = strExternal & "外部发送" & objRecip.Name & vbCr
            End If
        End If
    Next
    
    If strExternal <> "" Then
                  MSGText = "主题：「" & Item.Subject & "」" & vbCr & "要向下面的地址发送邮件，确定吗？" & _
        vbLf & "收信人地址:" & vbCr & strExternal
        If MsgBox(MSGText, vbYesNo, "发送确认") = vbNo Then
            Cancel = True
        End If
    End If
End Sub



Private Function FindContactByAddress(strAddress As String)
Dim objContacts
    Dim objContact
    Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts)
    Set objContact = objContacts.Items.Find("[Email1Address] = '" & strAddress _
        & "' or [Email2Address] = '" & strAddress _
        & "' or [Email3Address] = '" & strAddress & "'")
    Set FindContactByAddress = objContact

End Function