Установите отправителя почты перед отправкой в ​​Outlook

Question

Я использую событие «Application_ItemSend» для запуска некоторых действий с отправленными мной сообщениями. При определенных условиях почта переводится в новую подпапку. Поскольку вы не можете переместить почту до ее отправки без jepardizig отправки как таковой, я копирую почту перед отправкой и удалением оригинала после отправки. часть, которая обрабатывает это выглядит следующим образом:

Set myCopiedItem = objItem.Copy 
myCopiedItem.Move olTempFolder 
myCopiedItem.UnRead = False 
myCopiedItem.SentOnBehalfOfName = olSession.CurrentUser 
myCopiedItem.SendUsingAccount = olSession.Accounts(1) 
'myCopiedItem.SenderName = olSession.CurrentUser 
'myCopiedItem.SenderEmailAddress = olSession.CurrentUser.Address 
objItem.DeleteAfterSubmit = True 

Моя проблема заключается в том, что я хотел бы иметь меня в качестве отправителя по скопированной почте. Я попытался установить несколько разных свойств, но, к сожалению .SendOnBehalfOfName и. SendUsingAccount не делает то, что я делаю, и .SenderName и .SenderEmailAddress показали, что они «только для чтения». Любая идея, как я могу избежать того, что почта появляется в папке без отправителя?

Спасибо за любую идею

Ralf

Answer 1

Во-первых, Move - это функция, а не суб - возвращает вновь созданный элемент. Оригинал должен быть немедленно отброшен.

set myCopiedItem = myCopiedItem.Move(olTempFolder) 

Во-вторых, свойства, связанные с отправителем, устанавливаются только после того, как сообщение отправлено и перемещено в папку «Отправленные». Одно из решений - подождать, пока в папке «Отправленные» не произойдет событие Items.ItemAdd, а затем сделайте копию - к этому времени будут установлены свойства отправителя.

В теории вы можете установить дюжину или околои PR_SENT_REPRESENTING_* свойств MAPI, но если я правильно помню свои эксперименты, MailItem.PropertyAccessor.SetProperty не позволит вам установить некоторые свойства, связанные с отправителем. Если опция Redemption является опцией, она позволяет установить свойства и RDOMail.SentOnBehalfOf.

Answer 2

Будет ли эта работа для вас:

Сохранить адрес электронной почты в случае Application_ItemSend первый:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) 
    Item.Save 
    MoveEmail Item, "\\Mailbox - Darren Bartrup-Cook\Inbox\Some Folder\Some Sub Folder" 
End Sub 

В отдельном модуле (извините MoveEmail как функция - первоначально она вернула идентификатор электронной почты перемещенного сообщения электронной почты):

'---------------------------------------------------------------------------------- 
' Procedure : MoveEmail 
' Author : Darren Bartrup-Cook 
' Date  : 03/07/2015 
'----------------------------------------------------------------------------------- 
Public Function MoveEmail(oItem As Object, sTo As String) As String 

    Dim oNameSpace As Outlook.NameSpace 
    Dim oDestinationFolder As Outlook.MAPIFolder 

    Set oNameSpace = Application.GetNamespace("MAPI") 
    Set oDestinationFolder = GetFolderPath(sTo) 

    oItem.Move oDestinationFolder 

End Function 

'---------------------------------------------------------------------------------- 
' Procedure : GetFolderPath 
' Author : Diane Poremsky 
' Original : http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/ 
'----------------------------------------------------------------------------------- 
Function GetFolderPath(ByVal FolderPath As String) As Outlook.MAPIFolder 
    Dim oFolder As Outlook.Folder 
    Dim FoldersArray As Variant 
    Dim i As Integer 

    On Error GoTo GetFolderPath_Error 
    If Left(FolderPath, 2) = "\\" Then 
     FolderPath = Right(FolderPath, Len(FolderPath) - 2) 
    End If 
    'Convert folderpath to array 
    FoldersArray = Split(FolderPath, "\") 
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0)) 
    If Not oFolder Is Nothing Then 
     For i = 1 To UBound(FoldersArray, 1) 
      Dim SubFolders As Outlook.Folders 
      Set SubFolders = oFolder.Folders 
      Set oFolder = SubFolders.Item(FoldersArray(i)) 
      If oFolder Is Nothing Then 
       Set GetFolderPath = Nothing 
      End If 
     Next 
    End If 
    'Return the oFolder 
    Set GetFolderPath = oFolder 
    Exit Function 

GetFolderPath_Error: 
    Set GetFolderPath = Nothing 
    Exit Function 
End Function