Outlook：仅将已读邮件移动到文件夹

如何解决Outlook：仅将已读邮件移动到文件夹

要在Outlook中移动所有邮件，请使用以下代码：

var
  App,NS,Inbox,Items,OtherFolder,Item: OleVariant;
  i: Integer;
begin
  App := CreateOleObject('Outlook.Application');
  NS := App.GetNamespace('MAPI');
  NS.Logon;

  Inbox := NS.GetDefaultFolder(olFolderInbox);    
  OtherFolder := Inbox.Parent.Folders('Eléments supprimés');

  Items := Inbox.Items;
  for i := Items.Count downto 1 do
  begin
    Item := Items.Item(i);
    Item.Move(OtherFolder);
  end;
end.

是否可以仅将所有已读邮件移至该文件夹？

解决方法

简单的答案是使用Item.UnRead确定是否已阅读该项目，

1. 并非文件夹中的所有项目都不一定是支持UnRead属性的MailItem实例。您正在使用late binding来自动执行MS Outlook，如果尝试访问不支持该属性的项目的UnRead属性，该代码将崩溃。
2. 有更有效的方法。

为了演示这些选项，让我们首先远离后期绑定，这会使事情变得复杂而缓慢。将单元Outlook2010添加到您的using子句中。该单元的源代码位于RAD Studio安装位置的OCX \ Servers子文件夹中。然后，使用早期绑定处理邮件项目的代码框架如下所示：

uses
  System.SysUtils,System.Variants,Outlook2010;

var
  App: OutlookApplication;
  InboxFolder,OtherFolder: Folder;
begin
  App := CoOutlookApplication.Create;
  App.Session.Logon(EmptyParam,EmptyParam,EmptyParam);
  InboxFolder := App.Session.GetDefaultFolder(olFolderInbox);
  OtherFolder := (InboxFolder.Parent as Folder).Folders.Item('Eléments supprimés');
  ProcessFolder(InboxFolder,procedure(const Item: MailItem)
  begin
    Item.Move(OtherFolder);
  end);
end.

ProcessFolder的简单实现是：

type
  TMailItemProc = reference to procedure(const Item: MailItem);

procedure ProcessFolder(const AFolder: Folder; MailItemProc: TMailItemProc);
var
  ItemsToProcess: Items;
  Item: MailItem;
  Index: Integer;
begin
  ItemsToProcess := AFolder.Items;
  for Index := ItemsToProcess.Count downto 1 do
    if Supports(ItemsToProcess.Item(Index),MailItem,Item) and (not Item.UnRead) then
      MailItemProc(Item);
end;

这种方法很麻烦，因为它必须遍历文件夹中的每个项目并检查其UnRead状态。当文件夹中的项目数很多时，这可能会导致性能问题。但是我们可以做得更好。让Outlook努力工作。并且有多种方法可以做到这一点。以下摘要受How to get unread mail in Outlook文章的启发。

使用Items.Restrict方法：

procedure ProcessFolder(const AFolder: Folder; MailItemProc: TMailItemProc);
var
  ItemsToProcess: Items;
  Item: MailItem;
  Index: Integer;
begin
  ItemsToProcess := AFolder.Items.Restrict('[UnRead]=false');
  for Index := ItemsToProcess.Count downto 1 do
    if Supports(ItemsToProcess.Item(Index),Item) then
      MailItemProc(Item);
end;

使用Items.Find和Items.FindNext方法：

procedure ProcessFolder(const AFolder: Folder; MailItemProc: TMailItemProc);
var
  ItemsToProcess: Items;
  FoundItem: IDispatch;
  Item: MailItem;
begin
  ItemsToProcess := AFolder.Items;
  FoundItem := ItemsToProcess.Find('[UnRead]=false');
  while Assigned(FoundItem) do
  begin
    if Supports(FoundItem,Item) then
      MailItemProc(Item);
    FoundItem := ItemsToProcess.FindNext;
  end;
end;

使用Folders.GetTable方法：

procedure ProcessFolder(const AFolder: Folder; MailItemProc: TMailItemProc);
var
  Session: NameSpace;
  Table: OutlookTable;
  LRow: Row;
  FoundItem: IDispatch;
  Item: MailItem;
begin
  Session := AFolder.Session;
  Table := AFolder.GetTable('[UnRead]=false',EmptyParam);
  while not Table.EndOfTable do
  begin
    LRow := Table.GetNextRow;
    FoundItem := Session.GetItemFromID(VarToStr(LRow.Item('EntryId')),EmptyParam);
    if Supports(FoundItem,Item) then
      MailItemProc(Item);
  end;
end;