Can't modify PR_CLIENT_SUBMIT_TIME?

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
 
D

Dmitry Streblechenko

See my reply in the mapi newsgroup. Please do not multipost.

Dmitry Streblechenko (MVP)

-

"Burma" <somebody@somedomain.com> wrote in message

news:uREicwPqJHA.3364@TK2MSFTNGP06.phx.gbl...

> 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
 

Similar threads

Top