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