避免从错误账户发送邮件

引言

你在 Outlook 中配置了多个账户吗？ 你的工作账户和几个个人账户？ 曾经不小心从个人账户发送工作邮件吗？ 这段 Outlook 代码会在你犯错时提示你。

背景

我发现我经常从在 Outlook 中配置的个人账户发送工作邮件。 所以 VBA 来拯救了。

Using the Code

将以下代码插入到 ThisOutlookSession 模块中。 你可以通过显示菜单上的开发者功能区 来做到这一点。 然后选择功能区左侧的开发者功能区/Visual Basic。

在应用程序部分，插入以下代码。 你可以通过打开 'ThisOutlookSession' 来打开正确的源代码文件。 确保在左上角下拉框中选择了应用程序。

你需要在下面的代码中进行两处更改，更改部分用粗体标出。 将第一个粗体替换为你正在发送邮件的账户名称。 你可以通过在调试器中在第二个 if 语句上设置断点，并在从你的工作账户发送邮件时打印出 mail.SendUsingAccount 来找到它。

第二个粗体部分是贵公司电子邮件地址的域名。 例如，如果你的公司是 ZYX 并且你的电子邮件地址是 brady@ZYX.com，那么将其替换为 ZYX。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 Dim prompt As String
 Dim mail As Outlook.MailItem
 Dim r As VbMsgBoxResult
 Dim recips As Outlook.Recipients
 Dim recip As Outlook.Recipient
 Dim pa As Outlook.PropertyAccessor

If Item.Class = olMail Then
 
    Set mail = Item
    
    If mail.SendUsingAccount <> "myname@mycompanyemail.com" Then 
    
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set recips = mail.Recipients
    For Each recip In recips
        Set pa = recip.PropertyAccessor
        Debug.Print recip.Name & " SMTP=" _
           & pa.GetProperty(PR_SMTP_ADDRESS)
         ' replace companyDomain with the name of your companies domain email name.  
         ' The part after the @
         If InStr(1, pa.GetProperty(PR_SMTP_ADDRESS), "companyDomain", vbTextCompare) > 0 Then
         
            r = MsgBox("Do you want to send to companyDomain from non companyDomain account?", vbYesNo)
            If r = vbNo Then
                Cancel = True
                Exit For
                
            End If
        End If
    Next
       
    End If
End If
    
End Sub