For Each loop: Not deleting all emails

Question

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.

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!

Answer 1

You would also want to use Items.Find/FindNext or Items.Restrict instead of looping through all items in a folder.

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

Answer 2

Instead of iterating over all items in the folder and checking the following condition:

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

You can find the required items and iterate over a subset of items that correspond to your conditions.

See How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET) for a sample code. There you can find a similar article related to the Restrict method (can't post more than one link).

Answer 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.

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