Thursday, May 11, 2006

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.


No comments: