Question

我的问题与下面的问题相似但不一样，

基本上，某些内容（AV，Outlook或Exchange或两者中的错误）已将数百个传入（外部电子邮件） 修改为特定用户 作为草稿，现在出现作为不同意。这意味着用户无法回复这些消息，并且建议的复制和粘贴替代方案看起来非常不专业并且使用户的客户端感到困惑。谢天谢地，无论是什么导致它停止，但损坏已经完成。

我需要一些方法来以编程方式修改PR_MESSAGE_FLAGS。我对VB脚本，VBA，VB.Net甚至是C＃/ C ++感到满意，但是我对于如何做到这一点感到满意。

如果重要，服务器是Exchange 2013，客户端是Outlook 2010或2016（32或64位）。整个邮箱已导出到PST，如果有帮助，可以脱机工作。 :)

Answer 1

答案仍然相同 - 在低（扩展MAPI）级别，发送/未发送状态（MSGFLAG_UNSENT属性中的PR_MESSAGE_FLAGS位）只能在保存项目之前更改第一次。

Outlook对象模型当然受到相同的限制，在发送状态下创建项目的唯一方法是创建一个PostItem对象 - 它是在已发送状态下创建的。然后，您需要将邮件类更改回IPM.Note并删除与图标相关的属性，以确保该项目看起来正确。

Redemption允许您更改项目的状态（RDOMail。Sent是读/写，直到第一次调用Save。

在发送状态下创建现有未发送消息的副本应该非常容易 - 循环显示有问题的消息（如果要在同一文件夹中创建新项目，最好避免使用“for each” - “对于每个“循环将开始拾取新消息。首先遍历消息并将其条目ID存储在列表或数组中”，使用Redemption（RDOFolder.Items.Add）创建新项目，将Sent属性设置为true（RDOMail。 Sent = true），通过其条目ID（RDOSession.GetMessageFromID）打开有问题的消息，使用RDOMail.CopyTo（AnotherRDOMailObject）将有问题的消息复制到新消息中，在新消息上调用RDOMail.Save，在旧消息上调用RDOMail.Delete信息。

Answer 2

根据Dmitry的回答，这里是克隆旧邮件并将其标记为已发送的代码，以便可以回复它们。

只关注它是似乎打破对话。

Dim mysession

Sub doFixDrafts()
    log " Starting scan!"

    Set mysession = CreateObject("Redemption.RDOSession")
    mysession.Logon

    Const sRootFolder = "\\Mailbox\Inbox"

    Set oRootFolder = mysession.getfolderfrompath(sRootFolder)
    'Set oRootFolder = mysession.PickFolder

    doCleanupFolder oRootFolder, sRootFolder


    log "Scan complete!!"

End Sub

Sub doCleanupFolder(oFolder, sFolder)
    Dim c: c = 0
    Dim i: i = 0
    Dim tc: tc = Format(oFolder.Items.Count, "0000")

    'Get start timestamp so we can report in at regular intervals...
    Dim st: st = Now()

    log "Checking... " & sFolder

    Dim aMsgIDs()

    'Make a list of 'unsent' messages
    For Each Item In oFolder.Items
        i = i + 1
        If Not Item.Sent Then
            c = c + 1

            msgID = Item.EntryID
            ReDim Preserve aMsgIDs(1 To c)
            aMsgIDs(c) = msgID

            c = Format(c, "0000")
        End If

        'Give update for large folders...
        ct = Now()
        td = DateDiff("s", st, ct)
        If td > 15 Then
            log c & "/" & i & "/" & tc & " so far..."
            st = ct
        End If

        DoEvents
    Next
    c = Format(c, "0000")

    log c & "," & tc & "," & sFolder

    'Fix the corrupt messages
    For m = 1 To CInt(c)
        Set badMsg = mysession.GetMessageFromID(aMsgIDs(m))

        sSender = badMsg.Sender
        sSubject = badMsg.Subject
        dSentDate = badMsg.SentOn

        Set newMsg = oFolder.Items.Add("IPM.Note")
        newMsg.Sent = True
        badMsg.CopyTo (newMsg)
        newMsg.Save
        badMsg.Delete

        Dim a As String

        a = Format(m, "0000") & "," & sSender & ","
        a = a & Chr(34) & sSubject & Chr(34) & ","
        a = a & Chr(34) & dSentDate & Chr(34)

        log a

        DoEvents
    Next m


    For Each Item In oFolder.Folders
        doCleanupFolder Item, sFolder & "\" & Item.Name
    Next
         End Sub


Sub log(s As String)
    d = Format(Now(), "yyyy-mm-dd hh:mm:ss")

    t = d & " " & s

    Debug.Print t

    Const logfile = "c:\temp\fixdrafts.txt"

    Open logfile For Append As #1
    Print #1, t
    Close #1
End Sub

外部收到的邮件标记为草稿和未发送

2 个答案: