如何从特定帐户发送邮件？

Question

我正在使用Office 365（Outlook版本1909内部版本12026.20264）。

我配置了两个电子邮件帐户（[email protected]和[email protected]）和一个共享邮箱（[email protected]）。

使用我的[email protected]帐户，我有权从[email protected]发送电子邮件。

我可以从所有帐户（a @ a.com，b @ b.com，shared @ b.com）手动发送电子邮件。

我有VBA代码，可以使用SentOnBehalfOfName属性从[email protected]发送电子邮件。

Sub TEST()
  Dim origEmail As MailItem
  Dim replyEmail As MailItem

  Set origEmail = Application.ActiveWindow.Selection.Item(1)
  Set replyEmail = Application.CreateItemFromTemplate("C:\...\Template.oft")

  replyEmail.SentOnBehalfOfName = "[email protected]"
  replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
  replyEmail.Subject = "RE:" + origEmail.Subject

  replyEmail.Display
End Sub

通常，这可以正确发送电子邮件。我可以看到它们转到[email protected]帐户中的已发送文件夹。

[有时，它尝试使用[email protected]帐户发送电子邮件（该帐户无权从[email protected]发送电子邮件）。我在[email protected]上收到错误电子邮件，但未发送该电子邮件。

如何更改代码，以便每次我从[email protected]发送电子邮件时，它将使用我的[email protected]帐户？

注意：我将[email protected]帐户设置为默认帐户。

Answer 1

您需要将SendUsingAccount属性设置为与[email protected]邮箱相对应的Account对象。

Sub TEST()
  Dim origEmail As MailItem
  Dim replyEmail As MailItem

  Set origEmail = Application.ActiveWindow.Selection.Item(1)
  Set replyEmail = Application.CreateItemFromTemplate("C:\...\Template.oft")

  for each acc in Application.Session.Accounts
    if acc.DisplayName = "[email protected]" Then 
      replyEmail.SendUsingAccount = acc
      Exit for
    End If
  next 

  replyEmail.SentOnBehalfOfName = "[email protected]"
  replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
  replyEmail.Subject = "RE:" + origEmail.Subject

  replyEmail.Display
End Sub