发送邮件前检查是否用的是默认邮箱地址

outlook sender checker.vba

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim msg As Outlook.MailItem
    Dim favAcctName As String
    On Error Resume Next
    If TypeOf Item Is Outlook.MailItem Then
        favAcctName = Application.Session.Accounts(1).DisplayName '定义不检查的邮箱地址
        Set msg = Item
        If msg.SendUsingAccount <> favAcctName Then
        res = MsgBox(msg.SendUsingAccount & "不是默认邮箱地址，确定使用它发送么？", _
                     vbYesNoCancel + vbQuestion, _
                     "发件人检查")
        Select Case res
            Case vbYes
                Set msg.SendUsingAccount = _
                    Application.Session.Accounts(1)
            Case vbNo
                Cancel = True
            Case vbCancel
                Cancel = True
        End Select
        End If
    End If
    Set msg = Nothing
End Sub