对于每个循环:不删除所有电子邮件 [英] For Each loop: Not deleting all emails

查看:56
本文介绍了对于每个循环:不删除所有电子邮件的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我写了以下内容,以期将六个月以上的电子邮件保存到外部文件夹中:

I wrote the below in an attempt to save emails older than six months in an external folder:

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

它不能一次运行提取所有电子邮件,而我必须运行几次.我怀疑这与非电子邮件项有关,但我不确定.

It does not pick up all emails in one run, and I have to run it several times. I suspect it has to do with non emails items, but I am not sure.

此外,有时删除的电子邮件多于保存的电子邮件.例如:我在外部文件夹中找到229封电子邮件,在Outlook回收站中找到230封电子邮件.知道为什么吗?

In addition, sometimes, more emails are deleted than emails are saved. For example: I find 229 emails in the external folder, and 230 emails in the Outlook recycle bin. Any idea why?

最后,如果仍然需要提高代码的效率/速度,请随时告诉我!

Last, if there is anyway to improve the efficiency/speed of the code, please feel free to let me know!

推荐答案

删除(或移动)项目1时,项目2移至位置1.跳过该项目,移至现在位于位置2的项目3. .对于每一个都以相同的方式工作.

When you delete (or move) item 1, item 2 moves into position 1. You skip that item and move on to item 3 which is now in position 2. For Each works the same way.

一种解决方法是For i = oInboxFolder.Items.Count到1步-1

One way of dealing with this is For i = oInboxFolder.Items.Count to 1 step -1

这篇关于对于每个循环:不删除所有电子邮件的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆