Displaying E-mail Header Information (SnTT)

We all know about opening the email message and choosing View > Show > Page Source, right? On an email list someone asked how to display the header information today. I figured I would reply with a routine I have found and also use the chance to get another SnTT post out! So, here was my reply:

I have done the following in my mail file (I found it at devWorks a long time ago).

1. Create a LotusScript agent called "Get E-mail Headers."
2. The agent trigger should be "On event" by "Action menu selection" on "All
selected documents". It will give you the pop-up separately for each document.
3. Paste the code below into the Initialize Sub and save the agent.
4. With your e-mail folder open, just click Actions > Get E-mail Headers
and you will receive a pop-up window with the header information.
5. Then, if you were not aware, in Lotus Notes when you get a prompt
window you can hit CTRL-C and it will copy the text to the clipboard!! The prompt window looks like this:


6. The users can then paste the text in to a memo to you if you add this to the mail template.

Sub Initialize
 Dim s As New NotesSession
 Dim db As NotesDatabase
 Dim dc As NotesDocumentCollection
 Dim doc As NotesDocument,tempdoc As notesdocument
 Dim m As String, n As String
 Dim first As Integer, l As Integer
 
 l = 1
 Set db = s.CurrentDatabase
 Set dc = db.UnprocessedDocuments
 Set doc = dc.GetFirstDocument
 While Not(doc Is Nothing)
'' create a temporary copy of the document
  Set tempdoc = db.createdocument
  Call doc.CopyAllItems( tempdoc )
'' re-read the document items to ensure you are getting the remaining fields and not the removed ones
NextOne:
  Forall item In tempdoc.Items
   If item.Name = "Received" Then
    m = item.Text
    first = False
    For a = 1 To Len(m)
     If ( Mid$(m,a,5) = " " ) Then
      If ( first = False ) Then
       Mid$(m,a,1) = Chr$(10)
       first = True
      Else
       Mid$(m,a,1) = " "
      End If
     Else
      first = False
     End If
    Next
    If ( n = "" ) Then
     n = "<Hop " & l & ">"
     n = n & Chr$(13) & m
     l = l + 1
    Else
     n = n & Chr$(13) & "<Hop " & l & ">" & Chr$(13) & m
     l = l + 1
    End If
    m = ""
'' remove the current occurrence of the item so lotusscript will get the next one
    Call item.Remove
'' write the document so it will not contain the removed item
    Call tempdoc.save(True,True)
'' go back and re-read the document items to refresh the memory
    Goto NextOne
   End If
   
  End Forall
  If ( n <> "" ) Then
   Messagebox n,,doc.Subject(0)
  Else
   Messagebox "No Internet Received Headers found.",,doc.Subject(0)
  End If
  n = ""
'' delete the temporary document
  Call tempdoc.Remove( True )
  Set doc = dc.GetNextDocument(doc)
 Wend
End Sub

This LotusScript was converted to HTML using the ls2html routine,
provided by Julian Robichaux at nsftools.com.

Show-n-tell thursday