Listing 3: The StampDate() Subroutine
NONEXECUTABLE: To obtain the executable file, download the .zip file from the opening page of the article.
Sub StampDate()
    Dim objApp As Application
    Dim objItem As Object
    Dim objNS As NameSpace
    Dim strUser As String
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objItem = objApp.ActiveInspector.CurrentItem
    On Error Resume Next
    strUser = objNS.CurrentUser
    If Err <> 0 Then
        strUser = "user name not available"
        Err.Clear
    End If
    objItem.Body = objItem.Body & vbCrLf & Now() _
                  & " - " & strUser & vbCrLf
    Set objItem = Nothing
    Set objNS = Nothing
    Set objApp = Nothing
End Sub