我有一个用于搜索主题的宏,如果找到,则将电子邮件复制到另一个文件夹中。我的问题是它将电子邮件复制了 4 次,而不是只复制了一次。如果我在原始文件夹“Left Ones”中有 10 封电子邮件,那么在搜索和复制之后,我将在“TO BE REMOVED”文件夹中有 40 封电子邮件。欢迎任何帮助,谢谢。
Sub Search_Inbox()
Dim myOlApp As New Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim filteredItems As Outlook.Items
Dim itm As Object
Dim Found As Boolean
Dim strFilter As String
Dim subject_to_find As String
Dim myDestFolder As Outlook.Folder
subject_to_find = "something"
Set objNamespace = myOlApp.GetNamespace("MAPI")
Set objFolder = OpenOutlookFolder("\\Mailbox - ME\Inbox\Left Ones")
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & subject_to_find & "%'"
Set filteredItems = objFolder.Items.Restrict(strFilter)
If filteredItems.Count = 0 Then
Debug.Print "No emails found"
Found = False
Else
Found = True
For Each itm In filteredItems
If itm.Class = olMail Then
Debug.Print itm.Subject
Debug.Print itm.ReceivedTime
End If
Set myDestFolder = Session.Folders("Mailbox - ME").Folders("TO BE REMOVED")
For i = filteredItems.Count To 1 Step -1
Dim myCopiedItem As Object
Set myCopiedItem = filteredItems(i).Copy
myCopiedItem.Move myDestFolder
Next i
Next itm
End If
'If the subject isn't found:
If Not Found Then
'NoResults.Show
Else
Debug.Print "Found " & filteredItems.Count & " items."
End If
Set myOlApp = Nothing
End Sub
最佳答案
之后
Else
Found = True
添加行
Debug.Print filteredItems.Count
这是为了检查找到的项目数。这样,您就可以清楚地看到 VBA 是否真的找到了 40 封电子邮件(无论出于何种原因),或者它是否只是在之后复制了 4 次。
也尝试改变
Next i
到
i = i + 1
编辑:
切开
Next itm
并将其移动到该 block 的末尾:
For Each itm In filteredItems
If itm.Class = olMail Then
Debug.Print itm.Subject
Debug.Print itm.ReceivedTime
End If
Next itm 'move it here
关于vba - 复制找到的电子邮件 4 次,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/43632133/