При использовании нескольких учетных записей, как обеспечить отправку писем с правильной учетной записи

Question

Я использую 2 учетных записи электронной почты с Outlook. Один для работы, один для личного.

Проблема, с которой я столкнулся, заключается в том, что я постоянно отправляю рабочие письма из своего личного кабинета!

Как настроить список «не отправлять электронную почту на эти адреса, если они отправлены с определенной учетной записи»?

Answer 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) = "person@domain.com" ' block a person



'The only account you want to send emails to
    Dim theAccountsToSendEmailsFrom(0 To 0) As String
    theAccountsToSendEmailsFrom(0) = "dave@business.co.uk"

    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

Поскольку я хочу отправлять сообщения на домены только с моей рабочей учетной записи, при попытке отправить их с любого другого я получаю:

В противном случае, он просто отправит как обычно.

Приведенный выше код будет проверять каждый исходящий адрес электронной почты! Это означает, что он проверит To, CC и BCC ... Как только он находит единственного получателя, который соответствует, он покажет Приглашение, спрашивающее, хотите ли вы отправить или нет.