For Each循环：不删除所有的电子邮件

我写了下面的企图挽救超过六个月的电子邮件在一个外部文件夹：For Each循环：不删除所有的电子邮件

Option Explicit 

Public Sub EBS() 
Dim oMail As MailItem 
Dim sPath As String 
Dim dtDate As Date 
Dim sName As String 

Dim oNameSpace As Outlook.NameSpace 
Dim oInboxFolder As Outlook.Folder 
Dim i As Long 

Set oNameSpace = Application.GetNamespace("MAPI") 
Set oInboxFolder = oNameSpace.GetDefaultFolder(olFolderInbox) 

On Error Resume Next 
For i = 1 To oInboxFolder.Items.Count 
    Set oMail = oInboxFolder.Items(i) 
    If oMail.ReceivedTime < DateAdd("d", -180, Now) Then 
     sName = oMail.Subject 
     ChrRep sName, "_" 
     dtDate = oMail.ReceivedTime 
     sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & Format(dtDate, "_hhnnss", vbUseSystemDayOfWeek, vbUseSystem) & "_" & sName & ".msg" 
     sPath = "C:\ARCHIVE\OUTLOOK\Inbox\" 
     oMail.SaveAs sPath & sName, olMSG 
     oMail.Delete 
    End If 
Next i 

End Sub 

Private Sub ChrRep(sName As String, sChr As String) 

sName = Replace(sName, Chr(0), sChr) 
sName = Replace(sName, Chr(1), sChr) 
sName = Replace(sName, Chr(2), sChr) 
sName = Replace(sName, Chr(3), sChr) 
sName = Replace(sName, Chr(4), sChr) 
sName = Replace(sName, Chr(5), sChr) 
sName = Replace(sName, Chr(6), sChr) 
sName = Replace(sName, Chr(7), sChr) 
sName = Replace(sName, Chr(8), sChr) 
sName = Replace(sName, Chr(9), sChr) 
sName = Replace(sName, Chr(10), sChr) 
sName = Replace(sName, Chr(11), sChr) 
sName = Replace(sName, Chr(12), sChr) 
sName = Replace(sName, Chr(13), sChr) 
sName = Replace(sName, Chr(14), sChr) 
sName = Replace(sName, Chr(15), sChr) 
sName = Replace(sName, Chr(16), sChr) 
sName = Replace(sName, Chr(17), sChr) 
sName = Replace(sName, Chr(18), sChr) 
sName = Replace(sName, Chr(19), sChr) 
sName = Replace(sName, Chr(20), sChr) 
sName = Replace(sName, Chr(21), sChr) 
sName = Replace(sName, Chr(22), sChr) 
sName = Replace(sName, Chr(23), sChr) 
sName = Replace(sName, Chr(24), sChr) 
sName = Replace(sName, Chr(25), sChr) 
sName = Replace(sName, Chr(26), sChr) 
sName = Replace(sName, Chr(27), sChr) 
sName = Replace(sName, Chr(28), sChr) 
sName = Replace(sName, Chr(29), sChr) 
sName = Replace(sName, Chr(30), sChr) 
sName = Replace(sName, Chr(31), sChr) 
sName = Replace(sName, Chr(32), sChr) 
sName = Replace(sName, Chr(33), sChr) 
sName = Replace(sName, Chr(34), sChr) 
sName = Replace(sName, Chr(35), sChr) 
sName = Replace(sName, Chr(36), sChr) 
sName = Replace(sName, Chr(37), sChr) 
sName = Replace(sName, Chr(38), sChr) 
sName = Replace(sName, Chr(39), sChr) 
sName = Replace(sName, Chr(40), sChr) 
sName = Replace(sName, Chr(41), sChr) 
sName = Replace(sName, Chr(42), sChr) 
sName = Replace(sName, Chr(43), sChr) 
sName = Replace(sName, Chr(44), sChr) 
sName = Replace(sName, Chr(46), sChr) 
sName = Replace(sName, Chr(47), sChr) 
sName = Replace(sName, Chr(57), sChr) 
sName = Replace(sName, Chr(58), sChr) 
sName = Replace(sName, Chr(59), sChr) 
sName = Replace(sName, Chr(60), sChr) 
sName = Replace(sName, Chr(61), sChr) 
sName = Replace(sName, Chr(62), sChr) 
sName = Replace(sName, Chr(63), sChr) 
sName = Replace(sName, Chr(64), sChr) 
sName = Replace(sName, Chr(91), sChr) 
sName = Replace(sName, Chr(92), sChr) 
sName = Replace(sName, Chr(93), sChr) 
sName = Replace(sName, Chr(94), sChr) 
sName = Replace(sName, Chr(96), sChr) 
sName = Replace(sName, Chr(123), sChr) 
sName = Replace(sName, Chr(124), sChr) 
sName = Replace(sName, Chr(125), sChr) 
sName = Replace(sName, Chr(127), sChr) 
sName = Replace(sName, Chr(128), sChr) 
sName = Replace(sName, Chr(129), sChr) 
sName = Replace(sName, Chr(130), sChr) 
sName = Replace(sName, Chr(131), sChr) 
sName = Replace(sName, Chr(132), sChr) 
sName = Replace(sName, Chr(133), sChr) 
sName = Replace(sName, Chr(134), sChr) 
sName = Replace(sName, Chr(135), sChr) 
sName = Replace(sName, Chr(136), sChr) 
sName = Replace(sName, Chr(137), sChr) 
sName = Replace(sName, Chr(138), sChr) 
sName = Replace(sName, Chr(139), sChr) 
sName = Replace(sName, Chr(141), sChr) 
sName = Replace(sName, Chr(142), sChr) 
sName = Replace(sName, Chr(143), sChr) 
sName = Replace(sName, Chr(144), sChr) 
sName = Replace(sName, Chr(145), sChr) 
sName = Replace(sName, Chr(146), sChr) 
sName = Replace(sName, Chr(147), sChr) 
sName = Replace(sName, Chr(148), sChr) 
sName = Replace(sName, Chr(149), sChr) 
sName = Replace(sName, Chr(150), sChr) 
sName = Replace(sName, Chr(151), sChr) 
sName = Replace(sName, Chr(152), sChr) 
sName = Replace(sName, Chr(153), sChr) 
sName = Replace(sName, Chr(154), sChr) 
sName = Replace(sName, Chr(155), sChr) 
sName = Replace(sName, Chr(157), sChr) 
sName = Replace(sName, Chr(158), sChr) 
sName = Replace(sName, Chr(159), sChr) 
sName = Replace(sName, Chr(160), sChr) 
sName = Replace(sName, Chr(161), sChr) 
sName = Replace(sName, Chr(162), sChr) 
sName = Replace(sName, Chr(163), sChr) 
sName = Replace(sName, Chr(164), sChr) 
sName = Replace(sName, Chr(165), sChr) 
sName = Replace(sName, Chr(166), sChr) 
sName = Replace(sName, Chr(167), sChr) 
sName = Replace(sName, Chr(168), sChr) 
sName = Replace(sName, Chr(169), sChr) 
sName = Replace(sName, Chr(170), sChr) 
sName = Replace(sName, Chr(171), sChr) 
sName = Replace(sName, Chr(172), sChr) 
sName = Replace(sName, Chr(173), sChr) 
sName = Replace(sName, Chr(174), sChr) 
sName = Replace(sName, Chr(175), sChr) 
sName = Replace(sName, Chr(176), sChr) 
sName = Replace(sName, Chr(177), sChr) 
sName = Replace(sName, Chr(178), sChr) 
sName = Replace(sName, Chr(179), sChr) 
sName = Replace(sName, Chr(180), sChr) 
sName = Replace(sName, Chr(181), sChr) 
sName = Replace(sName, Chr(182), sChr) 
sName = Replace(sName, Chr(183), sChr) 
sName = Replace(sName, Chr(184), sChr) 
sName = Replace(sName, Chr(185), sChr) 
sName = Replace(sName, Chr(186), sChr) 
sName = Replace(sName, Chr(187), sChr) 
sName = Replace(sName, Chr(191), sChr) 
sName = Replace(sName, Chr(215), sChr) 
sName = Replace(sName, Chr(216), sChr) 
sName = Replace(sName, Chr(247), sChr) 
sName = Replace(sName, Chr(248), sChr) 

End Sub

它不拿起一个运行中的所有电子邮件，和我必须运行几次。我怀疑它与非电子邮件项目有关，但我不确定。

另外，有时会删除比电子邮件保存更多的电子邮件。例如：我在外部文件夹中找到229封电子邮件，在Outlook回收站中找到230封电子邮件。任何想法为什么？

最后，如果有无论如何提高代码的效率/速度，请随时让我知道！

来源

2014-12-03 clippertm

当您删除（或移动）项目1时，项目2移动到位置1.您跳过该项目并移到现在位置2的项目3中。对于每个都以同样的方式工作。处理这个问题

一种方式是对于i = oInboxFolder.Items.Count 1步-1

来源

2014-12-03 03:25:51 niton

Thanks Niton，它修复了项目跳过问题！（没有足够的声誉来标记答案是有用的） – clippertm 2014-12-03 05:42:01

你也想用Items.Find/FindNext中或Items.Restrict而不是通过所有循环的项目在一个文件夹中。

UPDATE：

setItems = oInboxFolder.Items 
set RestrictedItems = setItems.Restrict(" ([ReceivedTime ] < '05/02/2014')) AND ([MessageClass] = 'IPM.Note' ") 
for I = RestrictedItems.Count to 1 step -1 do 
    Set oMail = RestrictedItems.Item(I) 
next

来源

2014-12-03 03:31:40

Spasiva德米特里，这是一个伟大的建议！对Items.Restrict我还不是很熟悉（但）。我想我必须通过.class过滤，并带有mailitem值。当你有机会时，你能告诉我在这种情况下它是如何工作的吗？ – clippertm 2014-12-03 05:44:28

请参阅上面的更新。 – 2014-12-03 17:38:11

非常感谢德米特里！ – clippertm 2014-12-05 01:17:20

而不是遍历文件夹中的所有项目和检查以下条件：

If oMail.ReceivedTime < DateAdd("d", -180, Now) Then

您可以找到所需的物品，并遍历对应项的子集符合你的条件。

有关示例代码，请参见How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)。在那里你可以找到一篇与Restrict方法相关的文章（不能发布多个链接）。

来源

2014-12-03 12:29:03

感谢您的链接尤金，我会尝试查找方法，而不是一个循环。 – clippertm 2014-12-05 01:16:48

For Each循环：不删除所有的电子邮件

回答

相关问题