Can't modify PR_CLIENT_SUBMIT_TIME?

  • Thread starter Thread starter Burma
  • Start date Start date
B

Burma

I have a bunch of messages that are missing PR_CLIENT_SUBMIT_TIME. They
show "None" in Outlook's Sent column. I thought the code below should
do the trick but, although it runs without error, the messages with
"None" for the Sent date don't get modified. PR_MESSAGE_DELIVERY_TIME
is not missing for these messages. Is there something else i need to
do? Thanks

Sub FixDates()

On Error GoTo ErrorHandler

Dim ol As New Outlook.Application
Dim cfolder1 As MAPIFolder
Dim sItem As Redemption.SafeMailItem

Const cdoPR_CREATION_TIME = &H30070040
Const cdoPR_LAST_MODIFICATION_TIME = &H30080040
Const cdoPR_CLIENT_SUBMIT_TIME = &H390040 '0x00390040
Const cdoPR_MESSAGE_DELIVERY_TIME = &HE060040 '0x0E060040
Const cdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E '0x007D001E

Set cfolder1 = ol.Session.PickFolder
If cfolder1 Is Nothing Then Exit Sub
Set sItem = CreateObject("Redemption.SafeMailItem")
For Each Item In cfolder1.Items
sItem.Item = Item
With sItem
If IsNull(.Fields(cdoPR_CLIENT_SUBMIT_TIME)) Or _
IsEmpty(.Fields(cdoPR_CLIENT_SUBMIT_TIME)) Then
If Not IsNull(.Fields(cdoPR_MESSAGE_DELIVERY_TIME)) And _
Not IsEmpty(.Fields(cdoPR_MESSAGE_DELIVERY_TIME)) Then
.Fields(cdoPR_CLIENT_SUBMIT_TIME) =
..Fields(cdoPR_MESSAGE_DELIVERY_TIME)
End If
.Save
End If
End With
Next Item

Exit Sub

ErrorHandler:
MsgBox Err.Number & vbNewLine & Err.Description
Set cfolder = Nothing
Set ol = Nothing

End Sub
 
Back
Top