我正在寻找一个宏,以将会话中的较早电子邮件(按主题排序)移动到子文件夹,但该主题中的最新会话除外。
在同一对话中收到新邮件后,将旧电子邮件移至子文件夹。
我找到了移动7天以上的电子邮件的基地,但不确定如何移动较旧的对话并仅保留最新的邮件。
Sub MoveAgedMail()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As String
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
'Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set objSourceFolder = objNamespace.Folders("Online Archive - OTCGROUP@abc.ssmb.com").Folders("Inbox").Folders("DEST1")
' use a subfolder under Inbox
'Set objDestFolder = objSourceFolder.Folders("DEST")
Set objDestFolder = objNamespace.Folders("Online Archive - OTCGROUP2@abc.ssmb.com").Folders("Inbox").Folders("DEST2")
For intCount = objSourceFolder.Items.Count To 1 Step -1
Set objVariant = objSourceFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Then
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
' I'm using 7 days, adjust as needed.
If intDateDiff > 7 Then
objVariant.Move objDestFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1
End If
End If
Next
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub
答案 0 :(得分:0)
遍历文件夹中的所有项目并不是一个好主意:
FindGameObjectsWithTag(string tag)
改用 For intCount = objSourceFolder.Items.Count To 1 Step -1
Set objVariant = objSourceFolder.Items.Item(intCount)
类的Find
/ FindNext
或Restrict
方法。在以下文章中了解有关这些方法的更多信息: