comment on

Thanks to buckaduck for this lifesaver of a script. Our Notes setup here automagically deletes messages over 90 days weekly. Now I can save them off in a usuable & portable format.

I have made some modest changes to the script.

UPDATE: The script now saves messages with the same or related (FW & RE) to the same directory.

Here is my version:

# 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) a
+re
# 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) . '\\N
+otes2Files';
if(-d $dir)
   {
   print("Directory: $dir already exists.\nPlease choose another direc
+tory 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', 'S
+tationery');

# 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\] subdirector
+y: $!";
     }

  # 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 \[$subdi
+r/$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'};
  foreach my $attachment (@$array_ref) {
    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;
}
[download]

Doug

In reply to Re: Store Lotus Notes Email by NateTut
in thread Store Lotus Notes Email by buckaduck

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Perl: the Markov chain saw
	PerlMonks