Outlook VBA 宏循环以未指定的批次移动电子邮件

Question

这是我第一次在 Outlook 中使用 VBA。 我的代码可以运行，但在添加步骤时遇到了一个奇怪的问题

任务是：

1. 保存子文件夹 1 中的电子邮件到网络文件夹（效果很好）
2. 保存后，移动电子邮件从子文件夹1到子文件夹2（添加此步骤导致问题） （subfolder1 和 subfolder2 都是 Outlook 中默认收件箱文件夹下的子文件夹）

为第二个任务添加一行代码导致了一个奇怪的问题： 对于我正在测试的 12 封电子邮件，代码运行时不会出现错误消息，但一次只能处理几封电子邮件。我将不得不重新运行代码，并且需要执行 4 次才能完成所有 12 封电子邮件。

电子邮件按以下顺序处理：

• 6 封电子邮件（每次都是相同的，顺序相同）
• 3 封电子邮件（每次都是相同的，顺序相同）
• 2 封电子邮件（每次都是相同的，顺序相同）
• 1 封电子邮件

代码中没有条件可以停止它。

当我运行相同的代码而不添加任务#2 行时，宏会一次性处理所有 12 封电子邮件。 注释掉这一行解决了“批量”问题：
oMail.Move myFolder2

剩余的电子邮件会在后续运行中得到处理；不是一口气。

这是我的代码，主要来自：Macro to save selected emails of Outlook in Windows folder

Sub OutlookToDrive()

Dim myNameSpace As Outlook.NameSpace 'Object '(or Outlook.NameSpace)
Dim myFolder1 As Outlook.MAPIFolder  'Object '(or Outlook.MAPIFolder) folder to move FROM
Dim myFolder2 As Outlook.MAPIFolder 'Object '(or Outlook.MAPIFolder) Folder to move TO
Dim oMail As Object 'not specifying as 'mailobject' to include meeting invites
Dim sFileName As String
Dim dtdate As Date
Dim sDestinationFolder As String
Dim sFullPath As String
Dim sFolder1Name As String  'name of folder to move FROM
Dim sFolder2Name As String  'name of folder to move TO
Dim iCount As Integer

sDestinationFolder = "H:\PROD\Supplimentary_Info\"

 'subfolders under the default Inbox folder:
    sFolder1Name = "MoveFrom" 
    sFolder2Name = "MoveTo"    

Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder1 = myNameSpace.GetDefaultFolder(olFolderInbox).Folders(sFolder1Name)
Set myFolder2 = myNameSpace.GetDefaultFolder(olFolderInbox).Folders(sFolder2Name)

'initialize count
iCount = 0

For Each oMail In myFolder1.items

    sFileName = oMail.Subject   'Use email subject as file name

'"ReplaceCharsForFileName" is a function that I'm not including; no issues        
  ReplaceCharsForFileName sFileName, "()"  'replace characters

    dtdate = oMail.ReceivedTime
    sFileName = Format(dtdate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & _
            Format(dtdate, "-hhnnss", vbUseSystemDayOfWeek, vbUseSystem) & "-" & sFileName & ".msg"

    sFullPath = sDestinationFolder & "\" & sFileName

    If Dir(sFullPath) = "" Then
        iCount = iCount + 1

        Debug.Print TypeName(oMail) & " " & sFileName
        oMail.SaveAs sFullPath, olMSG   'save to specified path
        DoEvents

        oMail.Move myFolder2 'THIS LINE CAUSING ISSUE; BUT FINE IN BATCHES
        DoEvents
    End If        

Next

    MsgBox "Found " & iCount & " new emails in folder """ & myFolder1 & """ to save to path: " & vbNewLine & vbNewLine & sDestinationFolder

End Sub

在尝试诊断问题时，使用 debug.print 列表分批制作了电子邮件列表。 （粗体前缀数字是他们在邮件文件夹中的顺序，粗体前缀文本是电子邮件类型）

我更改了用于测试的电子邮件总数。新批次与我重复的次数保持一致：
共 15 封电子邮件；第 8、4、2、1 批
总共 6 封电子邮件；第 3、2、1 批
总共 5 封电子邮件；第 3、1、1 批
总共 3 封电子邮件；批次 2、1
共 2 封电子邮件；两人都通过了。是的！

（第 15 个计数组是通过在文件夹 1 中的原始 12 封电子邮件中添加 3 封新电子邮件而创建的。这 12 封电子邮件更改了它们在新测试组中的处理顺序。但是重新运行宏总是在相同的邮件中给出相同的电子邮件每次我测试时都有新批次）

Answer 1

这是 Alex de Jong 发布的修改后的回复。
当循环更改为：

For i = myFolder1.Items.count to 1 step -1
   Set oMail = myFolder1.Items(i)

   'Do your thing

Next i

Answer 2

试试这个：

For i = myFolder1.Items.count -1 to 0 step -1
   Set oMail = myFolder1.Items(i)
   'Do your thing

Next i

我怀疑你的循环跳过了一个项目，因为你从文件夹中删除了你的项目。