Lotus Notes - Detach and Save Mail Attachments

[pdupreez]

I have been trying to extract all mail attachments from my Lotus Notes mailbox. I found the code below on perlmonk, and it works fantastically, other than for one small problem.

It only saves the first attachment from the mail, and seemingly ignores the rest. I have looked everywhere to try and find a potential reason for this, and my perl skills are rudimentary.

Somewhere around here the attachments are read into an array?? and then saved one by one by looping through the array. Either the array is not populated properly or it is not properly looping, but I cannot find out which is which

# Save attachments as files, if any
my $array_ref = $doc->{'$FILE'};
foreach my $attachment (@$array_ref) {
print "Attachment in Message $num: $attachment";
if ($attachment) {
ExtractAttachment($doc, "$path/$subdir", $attachment);
}
}

Any ideas would be well appreciated.

Thanks (and thanks to the original contributors Kyle Krom (buckaduck)and Doug Marsh (NateTut) from perlmonk.com


# This program extracts email messages from a
# Lotus Notes account.
#
# Email messages will be saved in directories
# named for the mail folder they're stored in.
# All of these directories will be stored
# under a new top-level directory named
# "C:\temp\mail" by default, but this can be
# overridden with the -d flag.
#
# For each email message, a subdirectory will
# be created, containing the text and attachments
# for that message. These subdirectories are
# currently named by sequential numbers instead of
# by their subject titles. That's on my TODO list
# to fix; it shouldn't be too hard.
#
# Some folders in the Notes mail database are not
# really mail folders, so I try to skip them.
# Currently I skip all folders whose names are in
# parentheses (except for Inbox), and the folders
# in the array @badlist. You can customize @badlist
# as necessary.
#
# By default, Lotus Notes will open the email
# database for the PC's default user. To access
# the email for a different user: open Notes
# and switch to another userid first; then run
# this program while Notes is still open.
#
# Original by Kyle Krom (buckaduck)
#
# Tweaked by Doug Marsh (NateTut)
#
# Added Default Directory of "My Documents\Notes2Files"
# Added 'All by Purge Date', 'Stationery' to the @badlist
# Added an Exception for (Sent)
# Remove extraneous LFs from message.txt
# Message Directories are now named for $Subject
# Multiple Messages with the same or Related Subjects (i.e. FW & RE) are
# now stored to the same folder.
# Tweaked some prints
#
use strict;
use English;
use warnings;
use vars qw($opt_d $opt_v);
use charnames ':full';
use Getopt::Std;
use Win32::OLE;
use Win32;

# Command-line options:
# -d dirname Save everything under the directory "dirname"
# -v Verbose reporting of progress
getopt("d");

# Define a directory to store the results
my $dir = $opt_d || Win32::GetFolderPath(Win32::CSIDL_PERSONAL) . '\\Notes2Files';
if(-d $dir)
{
print("Directory: $dir already exists.\nPlease choose another directory or remove $dir.\n");
exit(1);
}
mkdir ($dir, 0755) or die "Can't make $dir: $!";
print("Saving Lotus Notes Mail in: $dir\\\n");

# Define a list of "Normal" folders to skip
my @badlist = ('_Archiving', 'Archiving\\Age of Documents',
'Discussion Threads', 'Events', 'All by Purge Date', 'Stationery');

# Auto-print carriage returns
$OUTPUT_RECORD_SEPARATOR = "\n";

# Open the email database in Lotus Notes
# (To use another person's email database, switch to
# their userid in Notes before running this program)
my $notes = Win32::OLE->new('Notes.NotesSession')
or die "Can't open Lotus Notes";
my $database = $notes->GetDatabase("","");
$database->OpenMail;

# Verify the server connection
print "Connected to ", $database->{Title},
" on ", $database->{Server} if $opt_v;

# Loop over all of the folders
foreach my $viewname (GetViews($database)) {

# Get the object for this View
print "Saving Messages in folder $viewname...";
my $view = $database->GetView($viewname);

# Create a subdirectory to store the messages in
$viewname =~ tr/()$//d;
$viewname =~ s(\\)(.)g;
my $path = "$dir/$viewname";
mkdir ($path, 0755)
or die "Can't make directory $path: $!";
chdir ($path);

# Get the first document in the folder
my $num = 1;
my $doc = $view->GetFirstDocument;
next unless $doc;
GetInfo($num, $path, $doc);

# Get the remaining documents in the folder
while ($doc = $view->GetNextDocument($doc)) {
$num++;
GetInfo($num, $path, $doc);
}
}

sub GetInfo {
my ($num, $path, $doc) = @_;

print "Processing message $num" if $opt_v;

# Create a new subdirectory based on the message number
my $Cleaned_Subject = $doc->{Subject}->[0];
while($Cleaned_Subject =~ s/[^A-z0-9\$%'`\-\@{}~!#()&_^ ]/\-/g)
{
;
}

$Cleaned_Subject =~ s/^\s*//;
$Cleaned_Subject =~ s/\s*$//;
$Cleaned_Subject =~ s/\\//;
$Cleaned_Subject =~ s/\s+/\-/g;

my $subdir = $Cleaned_Subject;
$subdir =~ s/^RE\-//i;
$subdir =~ s/^FW\-//i;
$subdir =~ s/^\-//i;

if($subdir eq '')
{
$subdir = 'No_Subject';
}

if(! -d $subdir)
{
mkdir ($subdir, 0755) or warn "Can't make \[$subdir\] subdirectory: $!";
}

# Write the contents of the message to a file
my $FileName = sprintf("%04d_Message.txt", $num);

open (TEXTFILE, ">$subdir/$FileName") or warn "Can't create \[$subdir/$FileName\] file: $!";
print TEXTFILE "From: ", $doc->{From}->[0];
print TEXTFILE "Subject: ", $doc->{Subject}->[0];
my $NewBody = $doc->{Body};
$NewBody =~ s/\x0D\n/\n/g;
print TEXTFILE $NewBody;
close TEXTFILE;

# Save attachments as files, if any
my $array_ref = $doc->{'$FILE'};
#$attachments = @$array_ref;
print scalar($array_ref)."<br />";
foreach my $attachment (@$array_ref) {
print "Attachment in Message $num: $attachment";
if ($attachment) {
ExtractAttachment($doc, "$path/$subdir", $attachment);
}
}
}

sub ExtractAttachment {
my ($doc, $path, $filename) = @_;

print "Extracting attachment $filename" if $opt_v;

# Get a Windows-friendly pathname for the file
$path = "$path/$filename";
$path =~ tr/\//\\/;

# Save the attachment to a file
my $attachment = $doc->GetAttachment($filename);
eval { $attachment->ExtractFile($path) };
if($?)
{
print("Error Saving Attachment:$filename:$?:$!:$@:$^E\n");
}
}

sub GetViews {
my ($database) = @_;
my @views = ();

# Loop through all of the views in this database
my $array_ref = $database->{Views};
foreach my $view (@$array_ref) {
my $name = $view->{Name};

# We only want folders if it's the Inbox or Sent
# or a normal folder name with no parentheses
if (($name eq '($Inbox)') or ($name eq '($Sent)') or ($name !~ /\(+.+\)/))
{
# Add the folder name to the @views list
# if it's not in the @badlist
push(@views, $name) unless (grep { $name eq $_ } @badlist);
}
}

return @views;
}

 

[pdupreez]

I have struggled with this and found my all solution by searching further and at the end I found a number of scripts which I cannibalized to give me a fairly good PERL script that will export each email as a text file, with its attachments into its own folder with a cleaned up subject field as the foldername and text file name.

A tree structure looks then as such:

Default Directory\[View Name In Lotus Notes]\[Cleaned Subject Field]\Cleaned Subject.txt

with also all attachments as originally named within the Lotus mail.

This will handle multiple attachments per email and I have extracted a 5GB mailbox with this containing 16000 mails without a problem. This does not work on selected mails, and only export wholesale from the main mailbox. This is set to save it in the d:\archives directory (which must not exist before you start) and you will have to modify it to suit your purposes. The core of the script comes from

http://www.perlmonk.org,

so please visit them if you wish to get the original script. I cannot remember where some of the other pieces come from unfortunately.

# This program extracts email messages from a
# Lotus Notes account.
#
# Email messages will be saved in directories
# named for the mail folder they're stored in.
# All of these directories will be stored
# under a new top-level directory named
# "C:\temp\mail" by default, but this can be
# overridden with the -d flag.
#
# For each email message, a subdirectory will
# be created, containing the text and attachments
# for that message. These subdirectories are
# currently named by sequential numbers instead of
# by their subject titles. That's on my TODO list
# to fix; it shouldn't be too hard.
#
# Some folders in the Notes mail database are not
# really mail folders, so I try to skip them.
# Currently I skip all folders whose names are in
# parentheses (except for Inbox), and the folders
# in the array @badlist. You can customize @badlist
# as necessary.
#
# By default, Lotus Notes will open the email
# database for the PC's default user. To access
# the email for a different user: open Notes
# and switch to another userid first; then run
# this program while Notes is still open.
#
# Original by Kyle Krom (buckaduck)
#
# Tweaked by Doug Marsh (NateTut)
#
# Added Default Directory of "My Documents\Archived-Notes2Files"
# Added 'All by Purge Date', 'Stationery' to the @badlist
# Added an Exception for (Sent)
# Remove extraneous LFs from message.txt
# Message Directories are now named for $Subject
# Multiple Messages with the same or Related Subjects (i.e. FW & RE) are
# now stored to the same folder.
# Tweaked some prints
#
use strict;
use English;
use warnings;
use vars qw($opt_d $opt_v);
use charnames ':full';
use Getopt::Std;
use Win32::OLE;
use Win32;

# Command-line options:
# -d dirname Save everything under the directory "dirname"
# -v Verbose reporting of progress
getopt("d");

# Define a directory to store the results
my $dir = 'D:\Archives';

# Define a list of "Normal" folders to skip
my @badlist = ('_Archiving', 'Archiving\\Age of Documents',
'Discussion Threads', 'Events', 'Mail By Sender', 'All by Purge Date', 'Unread\\unread', 'Stationery');

# Auto-print carriage returns
$OUTPUT_RECORD_SEPARATOR = "\n";

# Open the email database in Lotus Notes
my $notes = Win32::OLE->new('Notes.NotesSession')
or die "Can't open Lotus Notes";
my $database = $notes->GetDatabase("","");

$database->OpenMail;

# Verify the server connection
print "Connected to ", $database->{Title},
" on ", $database->{Server};

# Loop over all of the folders
foreach my $viewname (GetViews($database)) {

# Get the object for this View
print "Saving Messages in folder $viewname...";
my $view = $database->GetView($viewname);

my $path = 'D:\Archives';
chdir ($path);

# Get the first document in the folder
my $num = 1;

my $doc = $view->GetFirstDocument;

next unless $doc;
GetInfo($num, $path, $doc);

# Get the remaining documents in the folder
while ($doc = $view->GetNextDocument($doc)) {
$num++;
GetInfo($num, $path, $doc);
}
}

sub GetInfo {
my ($num, $path, $doc) = @_;

print "Processing message $num";

if ( $doc->HasEmbedded ) {

# Create a new subdirectory based on the message subject
my $Cleaned_Subject = $doc->{Subject}->[0];

$Cleaned_Subject =~s/Re\://gi;
$Cleaned_Subject =~s/Tr\://gi;

while($Cleaned_Subject =~ s/[^A-z0-9\$%'`\-\@{}~!#()&_^ ]/\-/g)
{
;
}

$Cleaned_Subject =~ s/^\s*//;
$Cleaned_Subject =~ s/\s*$//;
$Cleaned_Subject =~ s/\\//;
$Cleaned_Subject =~ s/\s+/\-/g;

my $subdir = $Cleaned_Subject;

$subdir =~ s/^RE\-//i;
$subdir =~ s/^FW\-//i;
$subdir =~ s/^Fw\-//i;
$subdir =~ s/^Tr\-//i;
$subdir =~ s/^Re\-//i;
$subdir =~ s/^\-//i;
$subdir =~ s/\-\-/\-/g;
$subdir =~ s/\-\-/\-/g;
$subdir =~ s/\-\-/\-/g;
$subdir =~ s/^\-//;

$subdir = substr($subdir, 0, 50);

$Cleaned_Subject = $subdir;

if($subdir eq '')
{
$subdir = 'No_Subject';
}

if(! -d $subdir)
{
print "Making subdirectory $subdir";
mkdir ($subdir, 0755) or warn "Can't make $path\$subdir directory: $!";
}

my $DocumentBody = $doc->GetFirstItem('Body');

foreach my $embeddedDoc ( $DocumentBody->{EmbeddedObjects} ) {
foreach my $arryele ( @{$embeddedDoc } ) {
my @array = $arryele->{Source};
ExtractAttachment($doc, "$path/$subdir", @array);
}
}
}

}

sub ExtractAttachment {
my ($doc, $path, $filename) = @_;

#Get a Windows-friendly pathname for the file
$path = "$path/$filename";
$path =~ tr/\//\\/;

#Save the attachment to a file
my $attachment = $doc->GetAttachment($filename);

if (-e "$path/$attachment") {
print "File exists!";
}
else {
# print "File does not exist.";

print "Extracting attachment $path";
eval { $attachment->ExtractFile($path) };
if($?)
{
print("Error Saving Attachment:$filename:$?:$!:$@:$^E\n");
}
}
}

sub GetViews {
my ($database) = @_;
my @views = ();

# Loop through all of the views in this database
my $array_ref = $database->{Views};
foreach my $view (@$array_ref) {
my $name = $view->{Name};

# We only want folders if it's the Inbox or Sent or a normal folder name with no parentheses
if ($name eq '($All)') # or ($name eq '($Sent)') or ($name !~ /\(.+\)/))
{
push(@views, $name); # unless (grep { $name eq $_ } @badlist);
}
}

return @views;
}

# END OF SCRIPT

#############################################################################

I have also modified the code slightly to allow me to export all attachments to a single directory by adding a sequential counter to the filename, therefore preventing overwriting of files with the same name.

It would probably be better to add the counter as a suffix rather than a prefix as it will allow for better sorting and filtering of similarly named files, but that would require parsing and concatenating of the filename before saving, and I am still struggling to understand regular expressions.

Somebody else can perhaps help out with that?
#############################################################################

# START OF FLAT EXPORT SCRIPT
use strict;
use English;
use warnings;
use vars qw($opt_d $opt_v);
use charnames ':full';
use Getopt::Std;
use Win32::OLE;
use Win32;

# Command-line options:
# -d dirname Save everything under the directory "dirname"
# -v Verbose reporting of progress
getopt("d");

# Define a directory to store the results
my $dir = 'D:\Archives';
my $Counter = 1;

# Define a list of "Normal" folders to skip
my @badlist = ('_Archiving', 'Archiving\\Age of Documents',
'Discussion Threads', 'Events', 'Mail By Sender', 'All by Purge Date', 'Unread\\unread', 'Stationery');

# Auto-print carriage returns
$OUTPUT_RECORD_SEPARATOR = "\n";

# Open the email database in Lotus Notes
my $notes = Win32::OLE->new('Notes.NotesSession')
or die "Can't open Lotus Notes";
my $database = $notes->GetDatabase("","");

$database->OpenMail;

# Verify the server connection
print "Connected to ", $database->{Title},
" on ", $database->{Server};

# Loop over all of the folders
foreach my $viewname (GetViews($database)) {

# Get the object for this View
print "Saving Messages in folder $viewname...";
my $view = $database->GetView($viewname);

my $path = 'D:\Archives';
chdir ($path);

# Get the first document in the folder
my $num = 1;

my $doc = $view->GetFirstDocument;

next unless $doc;
GetInfo($num, $path, $doc);

# Get the remaining documents in the folder
while ($doc = $view->GetNextDocument($doc)) {
$num++;
GetInfo($num, $path, $doc);
}
}

sub GetInfo {
my ($num, $path, $doc) = @_;

print "Processing message $num";

if ( $doc->HasEmbedded ) {

my $DocumentBody = $doc->GetFirstItem('Body');

foreach my $embeddedDoc ( $DocumentBody->{EmbeddedObjects} ) {
foreach my $arryele ( @{$embeddedDoc } ) {
my @array = $arryele->{Source};
ExtractAttachment($doc, "$path", @array);
}
}
}

}

sub ExtractAttachment {
my ($doc, $path, $filename) = @_;

$Counter = $Counter + 1;

#Get a Windows-friendly pathname for the file
$path = "$path/$Counter-$filename";
$path =~ tr/\//\\/;

print "Extracting attachment $path";

#Save the attachment to a file
my $attachment = $doc->GetAttachment($filename);



eval { $attachment->ExtractFile($path) };

if($?)
{
print("Error Saving Attachment:$filename:$?:$!:$@:$^E\n");
}
}

sub GetViews {
my ($database) = @_;
my @views = ();

# Loop through all of the views in this database
my $array_ref = $database->{Views};
foreach my $view (@$array_ref) {
my $name = $view->{Name};

# We only want folders if it's the Inbox or Sent or a normal folder name with no parentheses
if ($name eq '($All)') # or ($name eq '($Sent)') or ($name !~ /\(.+\)/))
{
push(@views, $name); # unless (grep { $name eq $_ } @badlist);
}
}

return @views;
}

 

[TrojanWarBlade]

Thanks for following up and posting your solution.
Many people post here and never bother to let us know that they have a solution so thumbs up from me for following up.




Trojan.