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

Question

要移动 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.

有没有办法只将所有已读 邮件移动到该文件夹？

Answer 1

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

并非文件夹中的所有项目都必须是 MailItem that supports the UnRead property. You're using late binding 的实例才能使 MS Outlook 自动化，如果您尝试访问 UnRead 属性不存在的项目，代码将崩溃不支持
有更有效的方法。

为了演示这些选项，让我们首先远离后期绑定，这会使事情变得有些复杂和缓慢。将 unit Outlook2010 添加到您的 uses 子句中。该单元的源代码位于 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, 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), MailItem, Item) then
      MailItemProc(Item);
end;

使用Items.Find and 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, MailItem, 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, MailItem, Item) then
      MailItemProc(Item);
  end;
end;

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

Outlook : Move only read mails to a folder

delphi

outlook