Thanks to a few other posts that gave me the core code for this script
I know this script is a little dependency heavy and relies
on you having Office 2007 so that you can disable the programmatic
access warnings but it feels fairly robust
Several uses were the inspiration for this script such as having
roving users drop files into and intranet folder, staff
who fill up their mailboxes can filter out the attachments into sender related
folders locally to clear down and a few more esoteric ones
Extra rules can be added near the bottom for post process
movement so that mail from specific people can be
redirected into completely different folders
I hope this helps someone to achieve something similar
it relies on having a few funky gif icons and a config file like:
[main]
test_mode=0
run_on_startup=1
hide_DOS_box=1
seconds_between_checks=20
root_destination_path=//server/share/DropBox/
delete_on_read=1
delete_moved_documents_from_drop_box=1;
#!/usr/bin/perl
#pragmas
use strict;
use warnings;
#modules
use Tk;
use Tk::Image;
use Win32;
use Win32::OLE qw(in with);
use Win32::OLE::Const 'Microsoft Outlook';
use Win32::GUI();
use Config::IniFiles;
use File::Copy;
#load config ini
my $config = new Config::IniFiles( -file => "config.ini" );
#hide DOS box
if($config->val('main','hide_DOS_box')){my $DOS = Win32::GUI::GetPerlW
+indow();Win32::GUI::Hide($DOS);}
#global status and root path
my $status;
my $root_destination_path=$config->val('main','root_destination_path')
+;
#test mode
my $test_mode=$config->val('main','test_mode');
#create GUI
my $window = MainWindow->new;
$window->title("Monitoring emails");
$window->iconimage($window->Photo(-file => 'ico.gif'));
my $photo=$window->Photo(-file => 'start.gif');
my $left_frame=$window->Frame(-padx=>10,-pady=>10)->pack(-side => 'lef
+t', -anchor => 'w');
my $right_frame=$window->Frame(-padx=>10,-pady=>10)->pack(-side => 'ri
+ght', -anchor => 'e');
my $main_frame_button = $left_frame->Button(-command=>\&main_frame_but
+ton_pressed,-image => $photo)->pack();
#set monitor refresh
$window->repeat(1000*$config->val('main','seconds_between_checks'),\&e
+xecute_monitor);
#launch monitor on startup
if($config->val('main','run_on_startup')){&start_monitor();&execute_mo
+nitor();}
#execute GUI
MainLoop;
#########################################################
# SUBROUTINES #
#########################################################
sub start_monitor{
$status=1;
$photo->configure(-file=>'stop.gif');
}
sub stop_monitor{
$status=0;
$photo->configure(-file=>'start.gif');
}
sub execute_monitor{
if($status){
my $outlook=Win32::OLE->new('Outlook.Application') or die "Can
+not create outlook object\nError:";
my $namespace = $outlook->GetNamespace("MAPI");
my $folder = $namespace->GetDefaultFolder(olFolderInbox);
my $items = $folder->Items;
for my $itemIndex (1..$items->Count){
my $message = $items->item($itemIndex);
next if not defined $message;
my $attach = $message->Attachments();
if (defined $attach){
for my $attach_index (1..$attach->Count){
my $attachment = $attach->item($attach_index);
my $filename = $attachment->Filename;
mkdir($root_destination_path.$message->SenderName)
+;
my $saveas = $root_destination_path.$message->Send
+erName."/$filename";
if(! -e $saveas){
$attachment->SaveAsFile($saveas);
if($test_mode){
Win32::MsgBox("Saving attachment from ".$m
+essage->SenderName." to $saveas\n");
}
}
}
}
if($config->val('main','delete_on_read')){$message->Delete
+;}
}
}
&apply_rules();
}
sub main_frame_button_pressed(){
if($status==0){
&start_monitor();
}else{
&stop_monitor();
}
}
sub apply_rules{
#define rules for additional file movement
my %rules = (
"Senders email name"=>"$root_destination_path/fh",
"Senders email name"=>"$root_destination_path/so",
);
#make sure directories exists
foreach(keys %rules){
mkdir $rules{$_};
}
my @directories_to_search = <$root_destination_path*>;
foreach my $directory(@directories_to_search){
$directory=~m/^.*\/(.*?)\s?$/;
if(-d $directory){
my $new_root=$rules{"$1"};
if($new_root){
my @files_to_move = <"$directory"/*>;
foreach my $file (@files_to_move){
my $from_path = $file;
$file=~s/$directory/$new_root/;
if($config->val('main','delete_moved_documents_fro
+m_drop_box')){
move($from_path,$file);
}else{
copy($from_path,$file);
}
}
}
}
}
}