对于每个循环：不删除所有电子邮件

时间：2014-12-03 02:47:11

标签： vba outlook

我写了以下内容，试图在外部文件夹中保存超过六个月的电子邮件：

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封电子邮件。知道为什么吗？

最后，如果无论如何都要提高代码的效率/速度，请随时告诉我们！

3 个答案:

答案 0 :(得分：2)

当您删除（或移动）第1项时，第2项移动到位置1.您跳过该项目并继续移动到位于第2位的第3项。对于每个工作方式相同。

解决这个问题的一种方法是For i = oInboxFolder.Items.Count到1步-1

答案 1 :(得分：0)

您还需要使用Items.Find / FindNext或Items.Restrict，而不是循环浏览文件夹中的所有项。

更新：

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

答案 2 :(得分：0)

而不是迭代文件夹中的所有项目并检查以下条件：

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)以获取示例代码。在那里，您可以找到与限制方法相关的类似文章（无法发布多个链接）。

相关问题
最新问题