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显示为“只读”。任何想法如何避免邮件显示在没有发件人的文件夹中？

感谢您的任何想法

拉尔夫

Answer 1

这对你有用吗？

首先将电子邮件保存在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是一个函数 - 最初它返回了移动电子邮件的EmailID）：

'----------------------------------------------------------------------------------
' 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

Answer 2

首先，Move是一个函数，而不是子函数 - 它返回新创建的项目。原件必须立即丢弃。

set myCopiedItem = myCopiedItem.Move(olTempFolder)

其次，只有在发送邮件并将其移动到“已发送邮件”文件夹后，才会设置与发件人相关的属性。一种解决方案是等到Items.ItemAdd事件在“已发送邮件”文件夹上触发并复制然后 - 将在该时间设置发件人属性。

理论上，您可以设置十几个PR_SENDER_*和PR_SENT_REPRESENTING_* MAPI属性，但如果我记得我的实验正确，MailItem.PropertyAccessor.SetProperty将不会让您设置一些与发件人相关的内容属性。如果使用Redemption是一个选项，则可以设置RDOMail.Sender和RDOMail.SentOnBehalfOf属性。

在Outlook

2 个答案: