Hi,I have written an eclipse plugin to extend the notes toolbar with a customized button. Now I want to implement the onButtonClick event in such a way that it extracts the content (text + attachments) of the selected Email and saves it in a file at a defined path.
The question is:
given the connection parameters to the mailserver (I use IMAP to get my emails in my Lotus Notes 8.5 Client), how can I get the content of a specific email?
Many thanks in advance
Hamadi
Subject: Exporting email
Once you’ve downloaded the emails to the client, it’s a matter of writing some script to save the message out as a text file, and then loop through the message itself if you want to export the attachments.
See the R6/7 forum as many have done this, but none of them are pretty and will take some tweaking as you run into issues with different types of attachments.
I wrote one for example that takes all my selected messages for export and puts them in my chosen directory, appends the attachment names to each text file, and then puts all the attachments in a subdirectory. I would share the code, but it’s not immediately accessible to me, and I got my bits and pieces out of the R6/7 forum anyway.
Subject: How to save lotus notes email content to filesystem
Hi,Thanks Erik for the quick response.
I have written a perl script using Win32::OLE to export Lotus Notes emails and attachments based on (http://www.perlmonks.org/?node_id=413732). But I would like to do this using C# (because I want to implement Drag and Drop fonctionality) or at least Java.
I quess you also used Perl?
I would be very gratefull for any links or sample code to extract Notes content (emails, metadata and attachments) using C# or Java?
Many Thanks in advance
Subject: Try this Agent
Sub Initialize On Error Goto Errhandle
Dim s As New NotesSession
Dim db As NotesDatabase
Dim coll As NotesDocumentCollection
Dim doc As NotesDocument
Dim ws As New NotesUIWorkspace
Set db = s.CurrentDatabase
Set coll = db.UnprocessedDocuments
Dim frm As String
Dim nam As NotesName
Dim fileNum As Integer
Dim pathBase As String
pathBase=ws.Prompt (PROMPT_OKCANCELEDIT, "Path in which eMails will be extracted", "Enter Path/Folder name(The Folder should exist) i.e. C:\Temp\", "C:\Temp\")
If Len(pathBase)<1 Then
Exit Sub
End If
For i = 1 To coll.Count
Set doc = coll.GetNthDocument( i )
filenames=Evaluate("@AttachmentNames",doc)
numberoffiles=Evaluate("@Attachments", doc)
'To extract Lotus Notes user name
Set nam=New Notesname(doc.GetItemValue("From")(0))
frm=nam.Common
If Instr(frm,Chr(34)) Then 'Check for " in the name, specially in single word name
frm=Mid(frm,2,Len(frm)-2)
End If
'To suppress duplicate folder
temp=doc.PostedDate(0)
datetime=Cstr(Day(temp))+Cstr(Month(temp))+Cstr(Year(temp))+Cstr(Hour(temp))+Cstr(Minute(temp))+Cstr(Second(temp))
temp=fullpath
fullpath=pathBase+ frm+" "+datetime
If Strcompare(fullpath,temp) Then
Mkdir fullpath
End If
If numberoffiles(0)>0 Then
For filecounter=0 To numberoffiles(0)-1
Print filenames(filecounter)
Set object = doc.GetAttachment( filenames(filecounter) )
If ( object.Type = EMBED_ATTACHMENT ) Then
fileCount = fileCount + 1
Call object.ExtractFile(fullpath & "\"& filenames(filecounter) ) '
End If
Next filecounter
End If
'Generate email text
fileNum% = Freefile()
Open fullpath & "\"& "eMail.txt" For Append As fileNum%
Set rtitem = doc.GetFirstItem( "Body" )
If ( rtitem.Type = RICHTEXT ) Then
plainText = rtitem.GetFormattedText( False, 0 )
End If
' write the formatted text to the file
Print #fileNum%, "From: "+ doc.From(0)
Print #fileNum%, "Date: " +Cstr(doc.PostedDate(0))
Print #fileNum%,"Message: "+plainText
' close the file
Close #fileNum
Next
Messagebox "Selected eMail(s) & attachments are been extracted in " & pathBase & " by NameDateTime folder format"
Exit Sub
Errhandle:
’ Use the Err function to return the error number and
’ the Error$ function to return the error message.
Messagebox "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl)
Resume Next
Exit Sub
End Sub
Subject: This agent will Detach and Remove attachment and create a link to its location
Code was taken from multiple sources and enhanced to accomidate all 3 needs, i.e. Detach, Remove and Link.
(Options)
Option Public
Option Declare
(Declarations)
%INCLUDE “lsconst.lss”
%INCLUDE “lserr.lss”
%REM
These declarations are in support of the MSWindows APIs that are used by this
agent. This means that this agent will only work on Win32 clients.
%END REM
Declare Function SHGetSpecialFolderLocation Lib “shell32.dll” (Byval hwndOwner As Long, _
Byval nFolder As Long, ppidl As Long) As Long
Const CSIDL_DRIVES = &H11
Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Declare Function SHBrowseForFolder Lib “shell32.dll” Alias “SHBrowseForFolderA” _
(lpbi As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib “shell32.dll” Alias “SHGetPathFromIDListA” _
(Byval pidl As Long, Byval pszPath As String) As Long
Declare Sub CoTaskMemFree Lib “ole32.dll” (Byval pv As Long)
’ Returns a file-path in the older DOS 8.3 notation without spaces
Declare Function GetShortPathNameA Lib “kernel32” (Byval lpszLongPath As String,_
Byval lpszShortPath As String, Byval cchBuffer As Long) As Long
%REM
Other global variables
%END REM
Public Const ENV_FOLDER_LOCATION = “DRL_FolderLocation”
Dim objAttachment As NotesEmbeddedObject
Dim rtStyleText As NotesRichTextStyle
Dim rtStyleSep As NotesRichTextStyle
Dim rtStyleLink As NotesRichTextStyle
Dim rtitem As Variant
Dim iCounter As Integer
Dim strExtractName As String
Dim strPath As String
Dim lAnswer As Long
Dim iFilenum As Integer
Dim lBoxTYpe As Long
Dim strMessage As String
Dim strNewLink As String
Dim strNamePart As String
Dim strExtPart As String
Initialize
Sub Initialize
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim view As NotesUIView
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim counter As Integer 'attachment counter
Dim iDocsProcessed As Integer 'processed message counter
Dim dupc As Integer 'duplicated filenames counter
Dim strDetachFolder As String 'receives name of temporary file path
Dim strMessage As String
Dim lBoxType As Long
Dim iErr As Integer
Dim iTaskId As Integer
Dim iTotalAttachments As Integer
Dim iNumDocAttachments As Integer
Dim iTotalDocuments As Integer
Dim iPercentCompleted As Integer
' General errors get trapped here
On Error Goto HandleError
' This on error traps the error that results when the agent attempts to
' open the collection from within a document rather than a view
On Error ErrObjectVariableNotSet Goto NoSelected
' Ensure we are using windows 32... if not then say goodbye.
If session.Platform <> "Windows/32" Then
strMessage = "Sorry, this only works on a Windows/32 platform at the moment!"
lBoxType = MB_OK+MB_ICONEXCLAMATION
Messagebox strMessage, lBoxType, "Warning"
Exit Sub
End If
' Do some initial stuff to make sure we are in a view and at least
' one document is selected before we go to the trouble of asking
' the user anything
Set db = session.CurrentDatabase
Set view = ws.CurrentView
' This statement will produce an error if the user is currently in a document
' rather than the view.
Set dc = view.Documents
'if no document selected
If dc.Count < 1 Then
strMessage = "You must have selected at least one document before doing this action!"
lBoxType = MB_OK+MB_ICONEXCLAMATION
Messagebox strMessage, lBoxType, "Warning"
Exit Sub
End If
' Get the folder to detach attachments into
If Not fGetDetachFolder(session, strDetachFolder) Then
Exit Sub
End If
iTotalDocuments = dc.Count
iDocsProcessed = 0
Set doc = dc.GetFirstDocument
While Not doc Is Nothing
iDocsProcessed = iDocsProcessed + 1
'detach each attachment
iNumDocAttachments = fDetachRemoveAndLink(session, doc, strDetachFolder)
iTotalAttachments = iTotalAttachments + iNumDocAttachments
iPercentCompleted = Int((iDocsProcessed / iTotalDocuments) * 100)
Print Cstr(iDocsProcessed) & " out of " & Cstr(iTotalDocuments) & _
" (" & Cstr(iPercentCompleted) & "%)"
Set doc = dc.GetNextDocument(doc)
Wend
strMessage = Cstr(iDocsProcessed) & " document(s) processed." & Chr(10) & _
"There were a total of " & Cstr(iTotalAttachments) & Chr(10) & _
"detached into the folder: " & strDetachFolder
lBoxType = MB_OK
Messagebox strMessage, lBoxType, "Finished!"
Call ws.ViewRefresh( )
Exit Sub
HandleError:
iErr = Err()
strMessage = "Please make sure that the folder: " & strDetachFolder & " is available."
lBoxType = MB_OK+MB_ICONSTOP
Messagebox strMessage, lBoxType, "Warning"
Exit Sub
NoSelected:
iErr = Err()
strMessage = "This action must only be taken while in a view!" & _
Chr(13) & "Use the Attachment, Detach All... action while in a document!"
lBoxType = MB_OK+MB_ICONEXCLAMATION
Messagebox strMessage, lBoxType, "Warning"
Exit Sub
End Sub
'Create these seven functions
Function fGetShortPathName(longpath As String) As String
Dim s As String
Dim i As Long
i = Len(longpath) + 1
s = String(i, 0)
GetShortPathNameA longpath, s, i
fGetShortPathName = Left$(s, Instr(s, Chr$(0)) - 1)
End Function
Function fGetFolderLocation() As String
Dim bi As BROWSEINFO ' structure passed to the function
Dim pidl As Long ' PIDL to the user's selection
Dim physpath As String ' string used to temporarily hold the physical path
Dim retval As Long ' return value
Dim vbNullChar As String
vbNullChar = Chr(0)
' Initialize the structure to be passed to the function.
' The owner of the dialog box.
bi.hwndOwner = 0
' Specify the My Computer virtual folder as the root.
retval = SHGetSpecialFolderLocation(0, CSIDL_DRIVES, bi.pidlRoot)
' Make room in the buffer to get the [virtual] folder's display name.
bi.pszDisplayName = Space(260)
' Message displayed to the user.
bi.lpszTitle = "Please choose a folder."
' Nothing else needs to be set.
bi.ulFlags = 0
bi.lpfn = 0
bi.lParam = 0
bi.iImage = 0
' Open the Browse for Folder dialog box.
pidl = SHBrowseForFolder(bi)
' If the user selected something, display its display name
' and its physical location on the system.
If pidl <> 0 Then
'Remove the empty space from the display name variable.
bi.pszDisplayName = Left(bi.pszDisplayName, Instr(bi.pszDisplayName, vbNullChar) - 1)
'Debug.Print "The user selected: "; bi.pszDisplayName
'If the folder is not a virtual folder, display its physical location.
physpath = Space(260)
retval = SHGetPathFromIDList(pidl, physpath)
If retval = 0 Then
'Debug.Print "Physical Location: (virtual folder)"
Else
' Remove the empty space and display the result.
physpath = Left(physpath, Instr(physpath, vbNullChar) - 1)
'Debug.Print "Physical Location: "; physpath
End If
' Free the pidl returned by the function.
CoTaskMemFree pidl
End If
' Whether successful or not, free the PIDL which was used to
' identify the My Computer virtual folder.
CoTaskMemFree bi.pidlRoot
' Return the physpath value
fGetFolderLocation = physpath
End Function
Function fGetDetachFolder(session As NotesSession, strDetachFolder As String) As Variant
On Error Goto HandleError
Dim strMessage As String
Dim lBoxType As Long
Dim lAnswer As Long
fGetDetachFolder = False
'get current saved folder
strDetachFolder = session.GetEnvironmentString( ENV_FOLDER_LOCATION )
'if the folder doesn't exist, show folder location window.
If Isempty(strDetachFolder) Or Len(strDetachFolder) < 2 Then
strDetachFolder = fGetFolderLocation()
If Len(strDetachFolder) < 2 Then
Exit Function
End If
'save strDetachFolder in to .ini
Call session.SetEnvironmentVar( ENV_FOLDER_LOCATION, strDetachFolder )
Else
'check the existance of the current folder, if it doesn't exist, prompt.
If fFileExists(strDetachFolder) Then
strMessage = "Current detach folder: "& strDetachFolder & " doesn't exist"
lBoxType = MB_OK + MB_ICONSTOP
Messagebox strMessage, lBoxType, "Detach Folder"
lAnswer = IDNO
Else
strMessage = "Use current default folder: " & strDetachFolder & "?"
lBoxType = MB_YESNO + MB_ICONQUESTION
lAnswer = Messagebox(strMessage, lBoxType, "Detach Folder")
End If
'if no current default folder, prompt for folder location window.
If lAnswer = IDNO Then
strDetachFolder = fGetFolderLocation()
'if the input string less than 2-character, stop
If Len(strDetachFolder) < 2 Then
Exit Function
End If
'save strDetachFolder in to .ini
Call session.SetEnvironmentVar( ENV_FOLDER_LOCATION, strDetachFolder )
End If
End If
fGetDetachFolder = True
Exit Function
HandleError:
strMessage = "Error in fGetDetachFolder: (" & Err & ") " & Error & " at line: " & Erl
lBoxType = MB_OK + MB_ICONSTOP
Messagebox strMessage, lBoxType, "Error!"
Exit Function
End Function
Function fDetachRemoveAndLinkR5(session As NotesSession, doc As NotesDocument, _
strDetachFolder As String) As Integer
'IN ORDER TO MAKE THIS WORK, REMOVE THE "R5" FROM THE THREE LINES OF CODE THAT EXIST
'WITHIN THIS FUNCTION
On Error Goto HandleError
fDetachRemoveAndLinkR5 = 0
iCounter = 0
' Look for rich text items in the document. Use the first rich text
' item found for rtitem - unless we find one named "Body" which will
' supercede any rich text item found thus far.
' If we don't find a rich text item then quit out of this document
Set rtitem = Nothing
Forall item In doc.Items
If item.Type = RICHTEXT Then
If rtitem Is Nothing Then
Set rtitem = doc.GetFirstItem(item.Name)
Elseif Strcompare(item.Name, "body", 5) = 0 Then
Set rtitem = doc.GetFirstItem(item.Name)
End If
End If
End Forall
' If we have not found a rich text item to use then scream and quit
' this document
If rtitem Is Nothing Then
strMessage = "Unable to locate any rich text items to hold the links " & _
"to the attachments that may be removed. Cannot process this document " & _
"with NoteId of: " & fFormatNoteId(doc.NoteId)
lBoxType = MB_OK+MB_ICONEXCLAMATION
Messagebox strMessage, lBoxType, "No RichText Item Found"
Exit Function
End If
' Iterate through each of the document's items looking for attachments
Forall item In doc.Items
If item.Type = Attachment Then
' Now that we have an attachment, get the embedded object
' associated with it. The first thing in the Values array
' is the name of the attachment.
Set objAttachment = doc.GetAttachment(item.Values(0))
iCounter = iCounter + 1
'get the attachment filename
strExtractName = objAttachment.Name
'generate a unique path for the file to be detached to - this
'involves checking for the existence of a file with the same name
'and incrementing a counter prepended to the filename until a
'name is found that does not exist in the detach folder.
strPath = strDetachFolder & "\" & strExtractName
iFilenum = 1
While fFileExists(strPath)
strNamePart = Strleftback(strExtractName, ".", 5)
strExtPart = Strrightback(strExtractName, ".", 5)
strPath = strDetachFolder & "\" & strNamePart & "_" & Cstr(iFilenum) & "." & strExtPart
iFilenum = iFilenum + 1
Wend
' Detach the attachment to the unique path
Call objAttachment.ExtractFile(strPath)
' Now create the link to the detached file so that we will
' be able to get to it from this document
' The link will be in the format:
' "Removed Attached file: <attachment> to [file:\\<pathtodetachedfile>]"
' Get the rich text item in which to append the links
'Set rtitem = doc.GetFirstItem("Body" )
' Create the rich text styles
Set rtStyleText = session.CreateRichTextStyle
Set rtStyleSep = session.CreateRichTextStyle
Set rtStyleLink = session.CreateRichTextStyle
' Initialize the styles for the three pieces of each linked file
rtStyleText.Bold = False
rtStyleText.NotesColor = COLOR_DARK_BLUE
rtStyleText.Underline = False
rtStyleText.NotesFont = FONT_HELV
rtStyleText.FontSize = 8
rtStyleSep.Bold = False
rtStyleSep.NotesColor = COLOR_BLACK
rtStyleSep.Underline = False
rtStyleSep.NotesFont = FONT_HELV
rtStyleSep.FontSize = 8
rtStyleLink.Bold = False
rtStyleLink.NotesColor = COLOR_BLUE
rtStyleLink.Underline = True
rtStyleLink.NotesFont = FONT_HELV
rtStyleLink.FontSize = 8
' Build the string to be used in the link
strNewLink = "file:\\" & fGetShortPathName(strPath)
' Append the link to the rich text field
If iCounter = 1 Then
Call rtitem.AddNewLine( 2 )
End If
Call rtitem.AppendStyle( rtStyleText )
Call rtitem.AppendText( "Removed attached file: " & strExtractName & " to " )
Call rtitem.AppendStyle( rtStyleSep )
Call rtitem.AppendText( " --> [ " )
Call rtitem.AppendStyle( rtStyleLink )
Call rtitem.AppendText( strNewLink )
Call rtitem.AppendStyle( rtStyleSep )
Call rtitem.AppendText( " ]" )
Call rtitem.AddNewLine( 1 )
' Remove the attachment from the document
Call objAttachment.Remove
End If
End Forall
' Save the document so that the changes we just made will be retained
Call doc.Save(True, False, True)
fDetachRemoveAndLinkR5 = iCounter
Exit Function
HandleError:
strMessage = "Error in fDetachRemoveAndLink: (" & Err & ") " & Error & " at line: " & Erl
lBoxType = MB_OK + MB_ICONSTOP
Messagebox strMessage, lBoxType, "Error!"
Exit Function
End Function
Function fFileExists(strPath As String) As Variant
fFileExists = Not (Dir(strPath) = "")
End Function
Function fFormatNoteId(strN As String) As String
' Format the NoteId so that it is 8 characters with leading 0's
If Len(strN) = 8 Then
fFormatNoteId = strN
Else
fFormatNoteId = String(8-Len(strN), "0") & strN
End If
End Function
Function fDetachRemoveAndLink(session As NotesSession, doc As NotesDocument, _
strDetachFolder As String) As Integer
On Error Goto HandleError
'Dim objAttachment As NotesEmbeddedObject
Dim rtStyleText As NotesRichTextStyle
Dim rtStyleSep As NotesRichTextStyle
Dim rtStyleLink As NotesRichTextStyle
Dim rtitem As Variant
Dim iCounter As Integer
Dim strExtractName As String
Dim strPath As String
Dim lAnswer As Long
Dim iFilenum As Integer
Dim lBoxTYpe As Long
Dim strMessage As String
Dim strNewLink As String
Dim strNamePart As String
Dim strExtPart As String
fDetachRemoveAndLink = 0
iCounter = 0
’ Look for rich text items in the document. Use the first rich text
’ item found for rtitem - unless we find one named “Body” which will
’ supercede any rich text item found thus far.
’ If we don’t find a rich text item then quit out of this document
Set rtitem = Nothing
Forall item In doc.Items
If item.Type = RICHTEXT Then
If rtitem Is Nothing Then
Set rtitem = doc.GetFirstItem(item.Name)
Elseif Strcompare(item.Name, "body", 5) = 0 Then
Set rtitem = doc.GetFirstItem(item.Name)
End If
End If
End Forall
’ If we have not found a rich text item to use then scream and quit
’ this document
If rtitem Is Nothing Then
strMessage = "Unable to locate any rich text items to hold the links " & _
"to the attachments that may be removed. Cannot process this document " & _
"with NoteId of: " & fFormatNoteId(doc.NoteId)
lBoxType = MB_OK+MB_ICONEXCLAMATION
Messagebox strMessage, lBoxType, "No RichText Item Found"
Exit Function
End If
’ Iterate through each of the rich text’s objects looking for attachments
Forall objAttachment In rtitem.EmbeddedObjects
If objAttachment.Type = EMBED_ATTACHMENT Then
iCounter = iCounter + 1
'get the attachment filename
strExtractName = objAttachment.Name
'generate a unique path for the file to be detached to - this
'involves checking for the existence of a file with the same name
'and incrementing a counter prepended to the filename until a
'name is found that does not exist in the detach folder.
strPath = strDetachFolder & "\" & strExtractName
iFilenum = 1
While fFileExists(strPath)
strNamePart = Strleftback(strExtractName, ".", 5)
strExtPart = Strrightback(strExtractName, ".", 5)
strPath = strDetachFolder & "\" & strNamePart & "_" & Cstr(iFilenum) & "." & strExtPart
iFilenum = iFilenum + 1
Wend
’ Detach the attachment to the unique path
Call objAttachment.ExtractFile(strPath)
Call objAttachment.Remove
’ Now create the link to the detached file so that we will
’ be able to get to it from this document
’ The link will be in the format:
’ “Removed Attached file: to [file:\]”
’ Get the rich text item in which to append the links
'Set rtitem = doc.GetFirstItem(“Body” )
’ Create the rich text styles
Set rtStyleText = session.CreateRichTextStyle
Set rtStyleSep = session.CreateRichTextStyle
Set rtStyleLink = session.CreateRichTextStyle
’ Initialize the styles for the three pieces of each linked file
rtStyleText.Bold = False
rtStyleText.NotesColor = COLOR_DARK_BLUE
rtStyleText.Underline = False
rtStyleText.NotesFont = FONT_HELV
rtStyleText.FontSize = 8
rtStyleSep.Bold = False
rtStyleSep.NotesColor = COLOR_BLACK
rtStyleSep.Underline = False
rtStyleSep.NotesFont = FONT_HELV
rtStyleSep.FontSize = 8
rtStyleLink.Bold = False
rtStyleLink.NotesColor = COLOR_BLUE
rtStyleLink.Underline = True
rtStyleLink.NotesFont = FONT_HELV
rtStyleLink.FontSize = 8
’ Build the string to be used in the link
strNewLink = "file:\\" & fGetShortPathName(strPath)
’ Append the link to the rich text field
If iCounter = 1 Then
Call rtitem.AddNewLine( 2 )
End If
Call rtitem.AppendStyle( rtStyleText )
Call rtitem.AppendText( "Removed attached file: " & strExtractName & " to " )
Call rtitem.AppendStyle( rtStyleSep )
Call rtitem.AppendText( " --> [ " )
Call rtitem.AppendStyle( rtStyleLink )
Call rtitem.AppendText( strNewLink )
Call rtitem.AppendStyle( rtStyleSep )
Call rtitem.AppendText( " ]" )
Call rtitem.AddNewLine( 1 )
End If
End Forall
’ Save the document so that the changes we just made will be retained
Call doc.Save(True, False, True)
fDetachRemoveAndLink = iCounter
Exit Function
HandleError:
strMessage = "Error in fDetachRemoveAndLink: (" & Err & ") " & Error & " at line: " & Erl
lBoxType = MB_OK + MB_ICONSTOP
Messagebox strMessage, lBoxType, "Error!"
Exit Function
End Function
Subject: Change this line
If session.Platform <> “Windows/32” Then
to
If instr(session.Platform , “Windows”) = 0 Then
Subject: Detach Save and Link agent - icons remain
after running the agent the attachements are saved, links created then deleted from the email - but the attachment icons remain (but go nowhere when clicked). How to get rid of those as well when the attachement is deleted?
Subject: Update - Can the agent be updated to work in 64 Bit OS
Nice Agent… My knowledge of programming is limited but can this agent be updated to work in 64 bit environment and can the file name be set as a hyperlink in the document to point to the file location rather that additional information displayed?
Also the browse for Folder window does not see files so it does not see shortcuts to folders that may be on Desktop etc.
Subject: Great script - one question though
Thanks for this script - helps a real lot. Question: Would like to store attachments on remote drives (e.g. via webDAV). How would I get the real path (e.g. https://xxx.yyy.com/folder/) as the link into the mail document? Would then be able to also retrieve detached attachments from mobile.
thanks
Chris