☰

使用多个账户时，如何确保电子邮件从正确的账户发送

tag-icon • tag-icon email microsoft-outlook vba
使用多个账户时，如何确保电子邮件从正确的账户发送

我在 Outlook 中使用了 2 个电子邮件帐户。一个用于工作，一个用于个人。

我遇到的问题是我总是用我的个人帐户发送工作邮件！

如何设置“如果从特定帐户发送电子邮件则不向这些地址发送电子邮件”列表？

答案1

我之前曾见过类似这样的问题，但现在找不到，所以我想我会问一下并回答它。

我编写了这个 VBa 来解决这个问题！现在，当我单击“发送”时，如果我不是从特定帐户发送，它将查看“发送到列表”，然后提示我取消或继续。这意味着它非常无创！如果我单击“取消”（不发送），电子邮件将保持打开状态且不变。

打开开发人员功能区，打开 Visual Basic。打开“ThisOutlookSession”并粘贴以下代码

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim oMail As MailItem
  Set oMail = Item

  Dim shouldSend As Boolean
  shouldSend = ShouldSendEmailFromBusinessAccount(oMail)
If Not (shouldSend) Then
    MSG1 = MsgBox("Are you sure you want to send this from the account you're using?", vbYesNo, "Are you sure?")
End If

If MSG1 = vbNo Then
    Cancel = True
End If

'Cancel = True

End Sub

Private Function ShouldSendEmailFromBusinessAccount(ByVal oMail As MailItem) As Boolean

    ShouldSendEmail = True

 'Set the recipients domains/email addresses you want to check.
    Dim sendToEmails(0 To 2) As String
    sendToEmails(0) = "@domain.co.uk" ' block a domain by TLD
    sendToEmails(1) = "domiain2" ' block an entire domain
    sendToEmails(2) = "[email protected]" ' block a person



'The only account you want to send emails to
    Dim theAccountsToSendEmailsFrom(0 To 0) As String
    theAccountsToSendEmailsFrom(0) = "[email protected]"

    Dim recCount As Integer
    Dim myRec As Outlook.Recipient
    Dim mySender As String

    mySender = oMail.SendUsingAccount

    For a = 0 To UBound(theAccountsToSendEmailsFrom)

    theAccountToSendEmailsFrom = theAccountsToSendEmailsFrom(a) ' note, one is plural

        If (InStr(mySender, theAccountToSendEmailsFrom) = 0) Then

            recCount = oMail.Recipients.Count
            For i = 1 To recCount

                Set myRec = oMail.Recipients(i)
                myAddress = myRec.Address

                For j = 0 To UBound(sendToEmails)
                    If (InStr(LCase(myAddress), LCase(sendToEmails(j)))) Then
                        MsgBox ("Ooops, you are going to send to: " & sendToEmails(j) & " from " & mySender)
                        ShouldSendEmail = False
                        Exit For
                    End If
                Next

            Next
        End If

    Next

    ShouldSendEmailFromBusinessAccount = ShouldSendEmail

End Function

因为我只想从我的工作帐户向域发送邮件，如果我尝试从任何其他帐户发送邮件，我会收到：

在此处输入图片描述

否则，它将像正常一样发送。

上述代码将检查每个外发电子邮件地址！这意味着它将检查收件人、抄送和密送...一旦找到匹配的收件人，它就会显示提示，询​​问您是否要发送。

相关内容