For Each 循环:通过 Outlook 邮箱循环删除项目时会跳过某些项目 [英] For Each loop: Some items get skipped when looping through Outlook mailbox to delete items
问题描述
我想开发以下 VBA 代码:
I wanted to develop VBA code that:
- 遍历邮箱中的所有电子邮件项
- 如果有任何类型的其他项目,请说日历邀请"会跳过该项目.
- 找出带有附件的电子邮件
- 如果附件有.xml"扩展名和特定标题,则将其保存到目录中,如果没有则继续搜索
- 执行第 4 步后,将所有包含 .xml 附件的电子邮件放入已删除邮件"文件夹,并通过循环删除该文件夹中的所有电子邮件.
代码完美运行,除了;例如
Code works perfect EXCEPT; For example
- 您的邮箱中收到了 8 封电子邮件,每封电子邮件都附有.xml"文件.
- 运行代码
- 您将看到 8 个项目中只有 4 个已成功处理,其他 4 个保留在其位置.
- 如果您再次运行代码,现在将成功处理 2 个项目,另外 2 个保留在您的邮箱中.
问题:运行代码后,它应该处理所有文件并在每次运行时将它们全部删除而不是其中的一半.我希望它在一次运行中处理所有项目.
Problem: After running the code, it is supposed to process all files and deletes them all not the half of them in each run. I want it to process all items at a single run.
顺便说一句,这段代码在我每次打开 Outlook 时都会运行.
BTW, this code runs every time I open the Outlook.
Private Sub Application_Startup()
'Initializing Application_Startup forces the macros to be accessible from other offic apps
'Process XML emails
Dim InboxMsg As Object
Dim DeletedItems As Outlook.Folder
Dim MsgAttachment As Outlook.Attachment
Dim ns As Outlook.NameSpace
Dim Inbox As Outlook.Folder
Dim fPathTemp As String
Dim fPathXML_SEM As String
Dim fPathEmail_SEM As String
Dim i As Long
Dim xmlDoc As New MSXML2.DOMDocument60
Dim xmlTitle As MSXML2.IXMLDOMNode
Dim xmlSupNum As MSXML2.IXMLDOMNode
'Specify the folder where the attachments will be saved
fPathTemp = "some directory, doesn't matter"
fPathXML_SEM = "some directory, doesn't matter"
fPathEmail_SEM = "some directory, doesn't matter"
'Setup Outlook
Set ns = GetNamespace("MAPI")
Set Inbox = ns.Folders.Item("mailbox-name").Folders("Inbox")
Set DeletedItems = ns.Folders.Item("mailbox-name").Folders("Deleted Items")
'Loop through all Items in Inbox, find the xml attachements and process if they are the matching reponses
'On Error Resume Next
For Each InboxMsg In Inbox.Items
If InboxMsg.Class = olMail Then 'if it is a mail item
'Check for xml attachement
For Each MsgAttachment In InboxMsg.Attachments
If Right(MsgAttachment.DisplayName, 3) = "xml" Then
'Load XML and test for the title of the file
MsgAttachment.SaveAsFile fPathTemp & MsgAttachment.FileName
xmlDoc.Load fPathTemp & MsgAttachment.FileName
Set xmlTitle = xmlDoc.SelectSingleNode("//title")
Select Case xmlTitle.Text
Case "specific title"
'Get supplier number
Set xmlSupNum = xmlDoc.SelectSingleNode("//supplierNum")
'Save the XML to the correct folder
MsgAttachment.SaveAsFile fPathXML_SEM & xmlSupNum.Text & "_" & Format(Date, "yyyy-mm-dd") & ".xml"
'Save the email to the correct folder
InboxMsg.SaveAs fPathEmail_SEM & xmlSupNum.Text & "_" & Format(Date, "yyyy-mm-dd") & ".msg"
'Delete the message
InboxMsg.Move DeletedItems
Case Else
End Select
'Delete the temp file
On Error Resume Next
Kill fPathTemp & MsgAttachment.FileName
On Error GoTo 0
'Unload xmldoc
Set xmlDoc = Nothing
Set xmlTitle = Nothing
Set xmlSupNum = Nothing
End If
Next
End If
Next
'Loop through deleted items and delete
For Each InboxMsg In DeletedItems.Items
InboxMsg.Delete
Next
'Clean-up
Set InboxMsg = Nothing
Set DeletedItems = Nothing
Set MsgAttachment = Nothing
Set ns = Nothing
Set Inbox = Nothing
i = 0
End Sub
推荐答案
可能的原因:当您执行此操作 InboxMsg.Move
时,收件箱中移动后的所有邮件都会被碰撞在列表中上升一位.所以你最终会跳过其中的一些.这是 VBA 的 For Each
构造的主要烦恼(而且它似乎也不一致).
Likely cause: When you do this InboxMsg.Move
, all of the messages in your inbox after the one that was moved are bumped up by one position in the list. So you end up skipping some of them. This is a major annoyance with VBA's For Each
construct (and it doesn't seem to be consistent either).
可能的解决方案:替换
For Each InboxMsg In Inbox.Items
与
For i = Inbox.Items.Count To 1 Step -1 'Iterates from the end backwards
Set InboxMsg = Inbox.Items(i)
这样你就可以从列表的末尾向后迭代.当您将消息移至已删除的项目时,列表中的以下项目何时增加一个并不重要,因为您已经处理了它们.
This way you iterate backward from the end of the list. When you move a message to deleted items, then it doesn't matter when the following items in the list are bumped up by one, because you've already processed them anyway.
这篇关于For Each 循环:通过 Outlook 邮箱循环删除项目时会跳过某些项目的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!