Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Automate Outlook via Win32::OLE to extract PDFs from mails

by Corion (Patriarch)
on Nov 02, 2023 at 08:46 UTC ( [id://11155327]=CUFP: print w/replies, xml ) Need Help??

This is my somewhat generic framework to process mails in specific folders in Outlook. The concrete use case here is to find and save PDFs that haven't been processed yet.

The script could also move mails or even reply to them, but the intention is to co-exist with human users of this shared mailbox, so the script scans several mail folders for files with an unknown name.

For more information on the object model (and especially the MailItem and Folder class), see the MS Outlook object model.

#!perl use 5.020; use feature 'signatures'; no warnings 'experimental::signatures'; use Getopt::Long; use utf8; use File::Basename 'dirname'; use File::Spec; use Win32::OLE 'in'; use Win32::OLE::Const 'Microsoft Outlook'; use Win32::OLE::Variant; use Scalar::Util 'blessed'; use Encode 'encode', 'decode'; use POSIX 'strftime'; #use PDFContents::Cache; # We output UTF-8 system('chcp 65001 >NUL:'); binmode STDOUT, ':encoding(UTF-8)'; local $| = 1; GetOptions( 'quick' => \my $quick_run, 'target-directory|t=s' => \my $target_dir, ); $target_dir ||= dirname($0) . "/INPUT"; my $target_dir = File::Spec->rel2abs( $target_dir ); my $outlook = Win32::OLE->GetActiveObject('Outlook.Application') || Win32::OLE->new('Outlook.Application', 'Quit'); my $namespace = $outlook->GetNamespace("MAPI"); #my $Folder = $namespace->GetDefaultFolder(olFolderInbox); # Output some folder names for debugging #for my $f (in($namespace->Folders->{"#MAGIC-MAILBOX"}->Folders->{Post +eingang}->Folders)) { # #say "Posteingang!" . $f->{Name}; #} sub progress( $info ) { state $last_progress; print join "", " " x length($last_progress), "\r", $info, "\r"; $last_progress = $info; } sub find_folder($path) { my $folder = $namespace->Folders->{"#MAGIC-MAILBOX"}; for my $el (split /!/, $path) { $el = encode('Latin-1', $el); my $next_folder = $folder->Folders->{$el}; if( ! $next_folder ) { warn "No folder found for '$el' in '$path'"; for( in($folder->Folders) ) { say "<$_->{Name}>"; }; }; $folder = $next_folder; }; return $folder; } # Read all PDFs we already rejected opendir my $dh, "$target_dir/rejected"; our @blacklist = readdir $dh; closedir $dh; # iterate over folders sub for_all_mails( $folder, $callback ) { if( ! $folder->Items ) { return 0; }; my $count; my $list = $folder->Items; my $msg = $list->GetFirst; while( $msg ) { $count += $callback->($msg); $msg = $list->GetNext; } return $count; } sub save_mail_attachments( $msg, $target_directory=$target_dir ) { foreach my $atch (reverse in($msg->{Attachments})) { my $name = $atch->{FileName}; if($name =~ m/.pdf$/i){ #say "Überspringe $_" if grep { $_ eq $name } @bla +cklist; next if grep { $_ eq $name } @blacklist; my $target = $target_dir . "/" . $name; if( ! -f $target or ! -s $target) { #$new++; $atch->SaveAsFile($target); } else { #say "Already exists ".$atch->{FileName}; } } } } sub save_attachments( $folder ) { progress($folder->Name); for_all_mails( $folder, \&save_mail_attachments ); } sub in_all_subfolders( $folder, $callback, $visual=$folder->Name ) { $callback->($folder); #for my $subfolder (grep { defined } $folder->Folders) { my $folders = $folder->Folders; my $subfolder = $folders->GetLast; while( $subfolder ) { in_all_subfolders( $subfolder, $callback, $visual . ' > ' . $s +ubfolder->Name ); $subfolder = $folders->GetPrevious; }; } my $count = 0; my $Folder = find_folder("Posteingang!incoming stuff"); #for my $f (in ($Folder->Folders)) { # say join "/", $Folder->{Name}, $f->{Name}; #}; # Find a folder named "from Somebody", but as a substring, since it mi +ght contain Umlauts or whatever for my $f (in ($Folder->Folders)) { #say join "/", $Folder->{Name}, $f->{Name}; if( $f->Name =~ m!from Somebody$! ) { $Folder = $f; last; }; }; $count += save_attachments( $Folder ); if( $quick_run ) { # nothing to do } else { in_all_subfolders( $Folder, sub( $this_folder ) { $count += save_attachments($this_folder); }); $count += save_attachments( find_folder("Posteingang")); $count += save_attachments( find_folder("Posteingang!to-sort")); $count += save_attachments( find_folder("Posteingang!to-sort-later +")); for my $folder (in(find_folder('Posteingang!in-progress')->Folders +)) { progress( $folder->Name ); $count += save_attachments( $folder ); } for my $folder (reverse in(find_folder('Posteingang!by-ticket-numb +er')->Folders)) { in_all_subfolders( $folder, sub( $this_folder ) { $count += save_attachments($this_folder); }); } } my $ts = strftime '%Y-%m-%dT%H:%M:%S', localtime; in_all_subfolders( find_folder("Posteingang!some!deep!subfolder"), sub +($folder) { my $foldername = $folder->{Name}; #progress($foldername); my $count; for_all_mails( $folder, sub( $msg ) { progress( "$foldername - $count" ); $count++; for my $att (reverse in($msg->{Attachments})) { my $id = $msg->{EntryId}; my $fn = $att->{FileName}; return unless $fn =~ /\.pdf\z/i; # process the PDF contents # PDFContents::Cache::add_mailinfo($foldername, $fn, $id, +$ts); } 1 }); }); progress(""); say "$count new PDFs found";

Replies are listed 'Best First'.
Re: Automate Outlook via Win32::OLE to extract PDFs from mails (grep mails)
by Corion (Patriarch) on Nov 02, 2023 at 08:49 UTC

    This is roughly a copy of the above program but demonstrates how to iterate over mails and grep for a regular expression in the mail body.

    It shows how to open a MailItem for display and user interaction.

    #!perl use 5.020; use feature 'signatures'; no warnings 'experimental::signatures'; use Getopt::Long; use File::Basename 'dirname'; use File::Spec; use Win32::OLE 'in'; use Win32::OLE::Const 'Microsoft Outlook'; use Win32::OLE::Variant; use Scalar::Util 'blessed'; system('chcp 65001 >NUL:'); binmode STDOUT, ':encoding(UTF-8)'; GetOptions( 'quick' => \my $quick_run, 'mailbox|mb=s' => \my $mailbox, 'start-folders|f=s' => \my @start_folder, 'open|o' => \my $do_open, 'print|p' => \my $do_print, ); =head1 NAME outlook-grep.pl - grep für Outlook =head1 SYNOPSIS perl outlook-grep.pl -o some-regular-expression --mailbox "#MAGIC-MA +ILBOX" =cut my $outlook = Win32::OLE->GetActiveObject('Outlook.Application') || Win32::OLE->new('Outlook.Application', 'Quit'); my $namespace = $outlook->GetNamespace("MAPI") or die "Couldn't get MAPI namespace?!"; if( ! @start_folder ) { push @start_folder, 'Posteingang'; } @start_folder = map { find_folder( $_ ) } @start_folder; my @keywords = @ARGV; sub progress( $info ) { local $| = 1; state $last_progress; print join "", " " x length($last_progress), "\r", $info, "\r"; $last_progress = $info; } sub find_folder($path) { my $folder = $namespace->Folders->{$mailbox}; for my $el (split /!/, $path) { progress( $el ); my $next_folder = $folder->Folders->{$el}; if( ! $next_folder ) { warn "No folder found for '$el' in '$path'"; for( in($folder->Folders) ) { say "<$_->{Name}>"; }; }; $folder = $next_folder; }; return $folder; } sub in_all_subfolders( $callback, $queue=[] ) { while( my $folder = shift @$queue ) { $callback->($folder); my $folders = $folder->Folders; my $subfolder = $folders->GetFirst; while( $subfolder ) { push @$queue, $subfolder; $subfolder = $folders->GetNext; }; } } sub found( $mailitem, $where, $options ) { progress(""); say sprintf "%s (%s)", $mailitem->{Subject}, $where; $mailitem->Display; } sub scan_mails( $folder, $options ) { my $visual = $folder->{Name}; progress(sprintf "%s", $visual); my $items = $folder->{Items}; if(! $items) { #warn sprintf "%s ist leer", $visual; return ; } my $mail = $items->GetFirst; my $total = $items->Count; my $count = 0; while( $mail ) { $count++; progress(sprintf "%s (%d/%d)", $visual, $count, $total); my @places; push @places, map { [$mail->{$_}, $_] } (qw(Subject HTMLBody)) +; push @places, map { [$_->Filename, 'Attachment'] } (in( $mail- +>Attachments)); #use Data::Dumper; warn Dumper $options; my ($found, $where); for my $v (@places) { my ($val,$w) = @$v; for my $str (@{$options->{ keyword }}) { if( $val =~ /\Q$str/) { $found = 1; $where //= $w; } } } if( $found ) { found( $mail, $where, $options ); }; $mail = $items->GetNext; } } my %search_options = ( keyword => \@keywords, ); in_all_subfolders( sub( $this_folder ) { scan_mails( $this_folder, \%search_options ); }, \@start_folder);

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://11155327]
Front-paged by Discipulus
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (3)
As of 2024-06-16 22:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.