To stamp outgoing mails, save this script in ThisOutlookSession

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As
Boolean)
If TypeName(Item) = MailItem Then
Dim strSubject As String
strSubject = Item.Subject
Item.Subject = strSubject & " " & Date & " " & Time
End If
End Sub


To stamp incoming mails, save this script in ThisOutlookSession

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim myNameSpace As NameSpace
Dim myInbox As Folder
Dim myItem As Object
Dim strSubject As String
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
For i = 1 To myInbox.Items.Count
Set myItem = myInbox.Items.Item(i)
If myItem.EntryID = EntryIDCollection Then Exit For
Next
strSubject = myItem.Subject
myItem.Subject = strSubject & " " & Date & " " & Time
myItem.Save
End Sub

To stamp an old email, save this script in a Module. Run manually after
selecting the email

Sub Date_Stamp_Subject()
Dim myItem As MailItem
Dim strsubject As String
Set myItem = GetCurrentItem()
myItem.Subject = strsubject & " " & Date & " " & Time
myItem.Save
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem =
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function

Regards,


--
rattanjits
http://forums.slipstick.com/