Access Outlook contacts using Perl and Win32::OLE

libwin32 for Perl on Windows systems provides convenient facilities for interfacing with any OLE object once you know the interface provided.

Note that an excellent source of information for Microsoft Office applications is the Object Browser. You can access it via Tools -> Macro -> Visual Basic Editor. Once you are in the editor, hit F2 to browse the interfaces, methods, and properties provided by Microsoft Office applications.

In this example, I am going to show how to get all email addresses in your contacts folder into a CSV file suitable for importing into Gmail or other webmail providers. (I know, you can do the export in Outlook itself, but I wanted to see if I could figure out how to do this via Perl, just as a proof of concept).

Note that, when you run this code, Outlook will warn you about a program attempting to access the contacts database. You'll need to allow the script to access the contacts database for it work.

I have only tried this code using Outlook 2003 on my computer. Hope it helps you but I am not sure if it will work everywhere.

Please note that while I provide this script in the hopes that it will be useful to you, I make NO GUARANTEES OR WARRANTIES OF ANY KIND. The code is provided subject to the same terms as Perl itself. For more information, please refer to the Perl Artistic License.

#!/usr/bin/perl

use strict;
use warnings;

use Win32::OLE qw(in with);
use Win32::OLE::Const 'Microsoft Outlook';
$Win32::OLE::Warn = 2;

my @FIELDS = (
    [ qw( Email1Address Email1DisplayName) ],
    [ qw( Email2Address Email2DisplayName) ],
    [ qw( Email3Address Email3DisplayName) ],
);

my $outlook = get_outlook();

my $mapi = $outlook->GetNamespace('MAPI');
my $contacts = $mapi->GetDefaultFolder(olFolderContacts);

my $count = $contacts->{Items}{Count};

print qq{"name","Email Address"\n};

for my $k (1 .. $count) {
    my $contact = $contacts->{Items}->Item($k);

    for my $field ( @FIELDS ) {
        if ( (my $addr = $contact->{ $field->[0] })
                and (my $name = $contact->{ $field->[1]}) ) {
            $name =~ s{(\s+\(.+\))}{};
            printf qq{"%s", %s\n}, $name, $addr;
        }
    }
}

sub get_outlook {
    my $outlook;
    eval {
        $outlook = Win32::OLE->GetActiveObject('Outlook.Application');
    };

    die "$@\n" if $@;

    return $outlook if defined $outlook;

    $outlook = Win32::OLE->new('Outlook.Application', sub { $_[0]->Quit })
        or die "Oops, cannot start Outlook: ",
               Win32::OLE->LastError, "\n";
}