Как переслать mailItem, скопированный из общего почтового ящика в локальную папку электронной почты, из локальной электронной почты?

Question

Я копирую письмо из общего почтового ящика в локальную папку в Outlook.

Я пытаюсь переслать письмо из моей локальной учетной записи электронной почты.

Когда я это делаю, он отправляется с учетной записи общего почтового ящика.

Я устанавливаю учетную запись на электронную почту как подтвержденную правильную учетную запись.

mailItem.Move myDestFolder
Set mailItem2 = mailItem.Forward
mailItem2.SendUsingAccount = oAccount (where oAccount is OutApp.Session.Accounts.Item (1))
mailItem2.Send

set mailItem2.SendUsingAccount = oAccount приводит к ошибке

Свойство доступно только для чтения

Хотите знать, если у меня нет прав для установки этого значения?

Option Explicit
Private rcvMail As Outlook.MailItem
Private fwMail As Outlook.MailItem
Private Const STR_MOVED_FOLDER As String = "Moved Emails"

Sub MoveAndForward()
    Dim myNamespace As Outlook.NameSpace
    Dim myInbox As Outlook.Folder
    Dim myDestFolder As Outlook.Folder
    Dim rcvFolder As Outlook.Folder
    Dim oAccount As Outlook.Account
    Dim myItems As Outlook.Items
    Dim myItem As Object
    Dim OutApp1 As Object
    Dim mailBoxFolderName As String
    Dim iEmailAccount As Integer
    Dim iRecipientCount As Integer
    Dim i As Integer

    Set OutApp1 = CreateObject("Outlook.Application")
    Set oAccount = OutApp1.Session.Accounts.Item(1) 
    Set myNamespace = Application.GetNamespace("MAPI")
    Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items

    CheckOrCreateFolder
    Set myDestFolder = myInbox.Folders(STR_MOVED_FOLDER)

    Set rcvMail = ReturnCurrentItem()

    If rcvMail.Class <> olMail Then
        MsgBox "This cannot be saved to file." & vbCrLf & _
          "Only Mail Items are supported.", vbExclamation, "Error"
        Exit Sub
    End If

    Set rcvFolder = rcvMail.Parent
    mailBoxFolderName = rcvFolder.Name

    rcvMail.Move myDestFolder

    Set fwMail = rcvMail.Forward
    Set fwMail.SendUsingAccount = oAccount

    iRecipientCount = fwMail.Recipients.Count

    If iRecipientCount > 0 Then
        For i = iRecipientCount To 1 Step -1
            fwMail.Recipients.Remove (i)
        Next i
    End If

    fwMail.Recipients.Add "*****@***.com"

    fwMail.Recipients.ResolveAll
    fwMail.Body = myNamespace.CurrentUser & " Took this email from the Mailbox" & _
      vbCrLf & rcvMail.Body

    fwMail.Send
    rcvMail.Close (olDiscard)

    Set rcvMail = Nothing
    Set fwMail = Nothing
    Set myNamespace = Nothing
    Set myInbox = Nothing
    Set myItems = Nothing
    Set myDestFolder = Nothing

    End
End Sub