保存不总是执行的 RDOMailItem答案

【问题标题】：Save a RDOMailItem not always executed保存不总是执行的 RDOMailItem
【发布时间】：2021-06-13 17:33:50
【问题描述】：

我使用来自 Dimastr 的 Redeption 在 Outlook VBA 中编写了以下代码，以尝试设置延迟电子邮件的 SentOn 和 ReceivedTime 属性，因为 Outlook 在您单击“发送”的那一天设置 ReceivedTime，而不是在实际发送时设置。它基于已发送项目文件夹上的 ItemAdd 事件。问题是有时它可以正常工作，但有时不能，特别是当电子邮件被推迟到另一天并且同时我关闭 Outlook 时。就像赎回保存调用不起作用或被覆盖。您是否做过类似的事情并找到了解决方案？

这是解码：

Private Sub SentItems_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
  
  Open FILEPATH For Append As 1
  Print #1, Now & " ItemAdd Step 1: " & item.Subject & " : " & item.SentOn & " - " & item.ReceivedTime & " - " & item.DeferredDeliveryTime

  If item.DeferredDeliveryTime <> #1/1/4501# Then
  
    Print #1, Now & " ItemAdd Step 2: " & item.Subject & " : " & item.SentOn & " - " & item.ReceivedTime & " - " & item.DeferredDeliveryTime
  
    If RDOSession Is Nothing Then
      Set RDOSession = CreateObject("Redemption.RDOSession")
      RDOSession.MAPIOBJECT = Application.Session.MAPIOBJECT
    End If
   
    Set sitem = RDOSession.GetMessageFromID(item.EntryID)
    sitem.SentOn = Now
    sitem.ReceivedTime = Now
    sitem.DeferredDeliveryTime = #1/1/4501#
    sitem.Save
    
    Print #1, Now & " ItemAdd Paso 3: " & sitem.Subject & " : " & sitem.SentOn & " - " & sitem.ReceivedTime & " - " & sitem.DeferredDeliveryTime
    
    Set sitem = Nothing

  End If
  
ProgramExit:
  Close #1
  Exit Sub
ErrorHandler:
  'MsgBox "The following error occurred: " & Err.Description
  Resume ProgramExit
End Sub

提前致谢。

【问题讨论】：

标签： outlook-redemption

【解决方案1】：

尝试换行

 Set sitem = RDOSession.GetMessageFromID(item.EntryID)

与

 Set sitem = RDOSession.GetRDOObjectFromOutlookObject(item)

【讨论】：

谢谢！我会尽力让你知道。
经过一些测试和调整后，它似乎工作正常。非常感谢您的解决方案。

【解决方案2】：

存储提供程序将PR_CLIENT_SUBMIT_TIME (SentOn) 设置为客户端应用程序调用Send 方法的时间。似乎该问题与 Redemption 库无关。我建议使用MFCMAPI 应用程序，看看扩展 MAPI 和存储提供程序是如何工作的。

【讨论】：