office365 - Move 50,000 selected emails (not all) from one IMAP folder to another on same server?

Question

I use an IMAP mail folder that contains 80,000 messages, and I'd like to move a selected subset of ~50,000 messages (all the messages dated in 2020) to another folder on the same IMAP server. Can this be scripted from the Linux command line on the client computer (not on the IMAP server computer)? Fetchmail? Movemail? Anything?

Also same question for deletion: is there a way to select (say) 50,000 emails from 2018 in an IMAP mail folder and delete them, via Linux command line tools?

Note: The server is outlook.com (Office 365) if it matters. I tried using Outlook (GUI) for this operation, but it can't even select "all emails from year" in any efficient way. I also tried Thunderbird with Owl to speak Exchange, and even though I can select the emails, the big move simply doesn't occur. A scripting approach is the latest attempt.

Thank you!

Answer 1

I recently found myself having to automatically move messages on an IMAP server from one folder to another.

To do this reliably, I wrote a script which I call imap-helper. It connects to an IMAP server and moves messages matching a given query string between two folders. It uses Mail::IMAPClient which is supplied by a package (perl-mail-imapclient) in my distribution (Arch).

In my coment on the original post I suggested using gnutls-cli to connect to your IMAP server; I still recommend doing this to get a grasp of what's happening behind the scenes (and so you can debug your query syntax more quickly). Here's an example raw IMAP session just for reference, but the script that follows it should be better suited for your problem.

• (The tool rlwrap provides GNU Readline editing and history to the interaction)

    $ rlwrap -S "> " gnutls-cli imap.mail.yahoo.com -p 993
    > A LOGIN myusername mypassword
    A OK LOGIN completed
    > A LIST "" *           # List all the folders on the server
    * LIST (HasNoChildren) "/" "ALL"
    * LIST (Junk HasNoChildren) "/" "Bulk Mail"
    * LIST (HasNoChildren) "/" "Inbox"
    ...
    A OK LIST completed
    > A SELECT Inbox
    * 12 EXISTS
    * 0 RECENT
    ...
    A OK [READ-WRITE] SELECT completed; now in selected state
    > A SEARCH BEFORE 01-Jan-2021
    * SEARCH 11 12
    A OK SEARCH completed
    > A MOVE 11,12 "Bulk Mail"
    * OK [COPYUID 1609256255 58:59 57:58]
    ...
    A OK MOVE completed
  

As for the script, I have tested it on my Gmail Inbox which has 13000 messages. I moved them all from INBOX to INBOX2 (which Gmail created automatically). This took a couple of minutes. Then I moved them back again. I'd be glad to hear if it works on your server.

For your case what you'd do is first create a file called ~/.imap-creds.pl with your server, username, and password.

Then you'd run something like

$ imap-helper outlook FOLDER1 'SINCE "01-Jan-2019" BEFORE "01-Jan-2020"' FOLDER2 -e

to move all messages in FOLDER1 that were received in 2019, into FOLDER2. The user interface is designed so that you can build the command one argument at a time:

$ imap-helper         # lists accounts from config file
gmail
...
$ imap-helper gmail   # lists folders in the gmail account
INBOX
Personal
Receipts
...
$ imap-helper gmail INBOX   # lists messages in INBOX
...
etc.

Here is the script:

#!/usr/bin/perl
# 21 Jan 2021
use warnings;
use strict;
use open (":encoding(UTF-8)", ":std" );

use Mail::IMAPClient;

use Data::Dumper;
$Data::Dumper::Indent=0;
$Data::Dumper::Purity=1;
$Data::Dumper::Terse=1;

use Getopt::Long;
Getopt::Long::Configure ("bundling", "no_ignore_case");

use Carp;
$SIG{__DIE__} = sub {
    my $error = shift;
    Carp::confess "Error: ";
};

# change the help text if you change this
my $credfn=glob("~/.imap-creds.pl");

my($bad_args, $help, $verbose, $execute, $max, $zero_results_ok);
GetOptions('-h|help' => $help,
           '-v|verbose' => $verbose,
           '-e|execute' => $execute,
           '-z|zero-results-ok' => $zero_results_ok,
           '-m|max=f' => $max
    ) or $bad_args = 1;

my ($action);

my ($acct, $src, $dst, $query);

sub verb {
  warn "imap-helper: ",@_,"
" if $verbose;
}

if(@ARGV>4) {
  warn "Expected 4 arguments but you passed ".scalar(@ARGV);
  $bad_args = 1;
} elsif(@ARGV==4) {
  $action = "move";
} elsif(@ARGV==3) {
  $action = "search";
} elsif(@ARGV==2) {
  $action = "list";
} elsif(@ARGV==1) {
  $action = "folders";
} elsif(@ARGV==0) {
  $action = "accounts";
}
($acct,$src,$query,$dst) = @ARGV;

sub usage {
   "Usage: imap-helper [-h | -v | -e | -z] ACCOUNT SRC_FOLDER QUERY DST_FOLDER
";
}
sub help {
  q{
Options:
-h --help     print this message
-v --verbose  be verbose
-e --execute  execute the move
-z --empty-search-ok   exit 0 on empty search (for scripts)

By default no messages are moved, pass -e to execute the move.

Configuration: ~/.imap-creds.pl
Config syntax: [ SERVER_NAME => { Server => "HOST",
    User     => "USER",
    Password => "PASS"
  }, ... ]

With zero arguments, lists accounts. With only the ACCOUNT argument,
lists folders on ACCOUNT. With SRC_FOLDER argument, list contents of
SRC_FOLDER. With QUERY argument, list results of QUERY. With
DST_FOLDER argument, plan a move of messages matching QUERY from
SRC_FOLDER to DST_FOLDER. Pass "-e" to execute the move.

QUERY is an IMAP query, like "ALL" or 'BEFORE "15-Jan-2021"' (dates must
be in this exact format). Other keywords include TO, CC, FROM,
SUBJECT, TEXT; AND, OR, NOT; LARGER, SMALLER; NEW, RECENT, SEEN,
ANSWERED. See <https://tools.ietf.org/html/rfc3501> for a full list.
IMAP queries can be combined, for example:

$ imap-helper gmail INBOX 'SINCE "01-Jan-2020" BEFORE "01-Jan-2021"'
# (lists all INBOX messages from 2020)

This tool uses MOVE which is not part of the original IMAP RFC but
which should be well supported.

Example interaction:

$ cat .imap-creds.pl
[ yahoo =>
  { Server   => 'imap.mail.yahoo.com',
    User     => 'napoleon',
    Password => 'MYPASSWORD123'
  },
  gmail => ...
]
$ imap-helper
yahoo
gmail
$ imap-helper yahoo
ALL
Archive
Inbox
...
$ imap-helper yahoo Inbox
48    19 Jan 2021  XXXXX@yahoo.com           YYYYY@gmail.com           test 2
...
$ imap-helper yahoo Inbox "BEFORE 15-Jan-2021"
50    29 Dec 2020  XXXXX@yahoo.com           YYYYY@yahoo.com           test 1
...
$ imap-helper yahoo Inbox "BEFORE 15-Jan-2021" Archive -e -v -z
imap-helper: Connecting to server imap.mail.yahoo.com as XXXXX
imap-helper: Searching for BEFORE 15-Jan-2021
imap-helper: Found 1 matches for BEFORE 15-Jan-2021
imap-helper: Moving 1 messages

};
}

if($bad_args) { print STDERR usage; exit(1) }
if($help) {
  my $pager = $ENV{PAGER};;
  open STDOUT, "| $pager" or warn "Not paging STDOUT: $!
" if defined $pager;
  print (usage, help);
  close(STDOUT); wait(); exit(0);
}

die "Shouldn't get here" if !defined $action;

################################################################
## LOGIN

if(!-e $credfn) {
  die "Missing credential file $credfn
";
}
my $creds = eval `cat $credfn`;
#verb (Dumper($creds));

ref $creds eq "ARRAY" or die "Expected an array: $credfn
".
    "Got: ".(Dumper($creds))."
";

if($action eq "accounts") {
  # no account specified, just list them all
  verb "Listing accounts from $credfn
";
  my $ind = 0;
  my @accts = grep {!($ind++ % 2)} (@$creds);
  print "$_
" for(@accts);
  exit(0);
}

my %creds = @$creds;

my $srvcr = $creds{$acct};
if(!defined $srvcr) {
  die "Account $acct not found in $credfn
";
}

verb "Connecting to server $srvcr->{Server} as $srvcr->{User}";

my $imap = Mail::IMAPClient->new(
  Server   => $srvcr->{Server},
  User     => $srvcr->{User},
  Password => $srvcr->{Password},
  Ssl      => 1,
  Uid      => 1,
    ) or die "Could not connect to $srvcr->{Server} as $srvcr->{User}
";

if($action eq "folders") {
  my $folders = $imap->folders
      or die "Error listing folders: ", $imap->LastError, "
";
  print join("
",@$folders),"
";
  exit(0);
}

$imap->select( $src )
    or die "Select $src error: ", $imap->LastError, "
";

# Truncate a string $s to width $w, for use in a table
sub trunc {
  my ($s, $w) = @_;
  $s = "" if !defined($s);
  if(ref $s eq "ARRAY") {
    $s = join(",",@$s);
  }
  my $l = length($s);
  my $o;
  if($l>=$w) {
    $o = substr($s,0,$w-3)."...";
  } else {
    $o = $s.(" "x($w-$l));
  }
  return $o;
}

sub show_msgs {
  my @msgs = @_;
  # this should but doesn't work (as first argument to parse_headers)
#  my $r = $imap->Range(@msgs);

  my $heads = $imap->parse_headers(@msgs, "Date", "Subject", "To", "From");
#  for my $msg (sort {$a <=> $b} (keys %$heads)) {
  for my $msg (@msgs) {
    my $hs = $heads->{$msg};
    my $date = $hs->{Date}->[0]||"";
    # remove weekday and HH:MM:SS from date
    $date =~ s/^D+,s*//;
    $date =~ s/ dd:.*$//;
    print trunc($msg,7)," ",
        trunc($date,12)," ",
        trunc($hs->{To},25)," ",
        trunc($hs->{From},25)," ",
        trunc($hs->{Subject},25),
        "
";
  }
}

if($action eq "list") {
  my @msgs = $imap->messages;
  if(defined($max) && @msgs>$max) { @msgs = @msgs[0..($max-1)]; }
  show_msgs(@msgs);
  exit(0);
}

verb "Searching for $query";
my @msgs = $imap->search($query);
if(!@msgs) {
  if(!$zero_results_ok) {
    die "Error or no matches for $query ",$imap->LastError,"
";
  } else {
    verb "No matches found for $query";
    exit 0;
  }
}
verb "Found ".(@msgs)." matches for $query";
if(defined $max && @msgs > $max) { @msgs = @msgs[0..($max-1)]; }

if($action eq "search") {
  show_msgs(@msgs);
  exit(0);
}

if($action eq "move") {
  verb "Moving ".(@msgs)." messages";
  my $msgstr=join(",",@msgs);
  if(!$execute) {
    warn "Would have moved $msgstr from $src to $dst
";
    warn "Pass -e to execute move
";
  } else {
    $imap->move($dst,$msgstr)
        or die "Could not move messages
";
  }
  exit(0);
}

die "Something wrong";