遍历 Outlook 文件夹丢失 1 封电子邮件

Question

我正在尝试遍历 Outlook 中的特定文件夹，并对收件箱子文件夹中的每封电子邮件执行以下操作：

(1) 将每封邮件中的每个附件保存到特定位置//大多数邮件只有1个 (2) 将邮件移动到特定的子文件夹

下面的代码工作得很好，除了它不处理 1 封电子邮件。如果文件夹中有 3 封电子邮件，它会处理 2 封并保留最后一封。

我不确定发生了什么。这是我正在使用的代码：

Dim OlApp                          
Dim OlMail                         
Dim OlItems                       
Dim Olfolder                       
Dim OlSubfolder                    
Dim MyNameSpace
Dim J As Integer
Dim strFolder As String
Dim MyFileName() As String
Dim EmailCount As Integer
Dim X As Integer

Set OlApp = GetObject(, "Outlook.Application")
    
If Err.Number = 429 Then
    Set OlApp = CreateObject("Outlook.Application")
End If

strFolder = ""
strFolder = "C:\Temp\MarketPay\"
    
Set MyNameSpace = Application.GetNamespace("MAPI")

Set Olfolder = MyNameSpace.Folders.Item("Efficiency Tools").Folders.Item("Inbox").Folders.Item("HomePay").Items

Set OlSubfolder = MyNameSpace.Folders("Efficiency Tools").Folders("Inbox").Folders("HomePay").Folders("Completed")

//only used to validate the number of emails in the folder
EmailCount = 0
EmailCount = Olfolder.Count
    
X = 1
    
For Each OlMail In Olfolder

     DoEvents
    
     For J = 1 To OlMail.Attachments.Count
                        
          ReDim Preserve MyFileName(1 To X)
                
          MyFileName(X) = OlMail.Attachments.Item(J)
                
          OlMail.Attachments.Item(J).SaveAsFile strFolder & OlMail.Attachments.Item(J)
                
          OlMail.Attachments.Item(J).SaveAsFile strFolder & OlMail.Attachments.Item(J).FileName
                
            X = X + 1
                
        Next J
    
        OlMail.Move OlSubfolder

    Next

我不经常在 Outlook 中使用 VBA，所以我怀疑这是我遗漏的东西。附件是一个每天自动生成的 csv 文件。电子邮件是相同的。唯一的例外是主题行中的日期。

提前感谢您的帮助.........

Answer 1

您不应该使用枚举器 (

for each

) 循环遍历集合，同时修改它（通过移动消息）。

改变循环从

For Each OlMail In Olfolder

向下循环：

for i = Olfolder.Count to 1 step -1
  set OlMail = Olfolder(i)

Answer 2

迭代 Outlook 文件夹中的所有项目并不是一个好主意：

For Each OlMail In Olfolder

相反，如果您需要查找所有带有附件的项目并对其进行迭代，您可以使用

Find

/

FindNext

或

Restrict

类的

Items

方法。它们允许获取符合指定搜索条件的项目，例如，要获取带有附件的项目，您可以使用以下搜索字符串：

query ="@SQL=" & chr(34) & "urn:schemas:httpmail:hasattachment" & chr(34) & "=1"

在代码中我注意到多行代码具有可重复的代码，例如：

MyFileName(X) = OlMail.Attachments.Item(J)
                
MyFileName(X).SaveAsFile strFolder & MyFileName(X)

MyFileName(X).SaveAsFile strFolder & MyFileName(X).FileName

如果您已经检索到相同的对象，那么重复使用它是有意义的。

MyFileName(X) = OlMail.Attachments.Item(J)
                
OlMail.Attachments.Item(J).SaveAsFile strFolder & OlMail.Attachments.Item(J)
OlMail.Attachments.Item(J).SaveAsFile strFolder & OlMail.Attachments.Item(J).FileName

请注意，SaveAsFile 方法接受一个字符串，该字符串代表保存附件的位置。因此，您需要确保传递了有效的文件路径：

MyFileName(X).SaveAsFile strFolder & MyFileName(X)

最后，要从集合中删除或移动项目，我建议使用反向 for 循环，以便您的索引始终指向集合中的有效项目。