我有四个宏，当它们一起使用时，将扫描我的收件箱及其所有子文件夹，并将除日历类型邮件外的所有未读邮件标记为已读。
这是低效的，因为它遍历每个邮件。
我有一个不同的脚本，这不是一个问题，但是，当它遇到日历类型的邮件项目时，它失败了。
我正在寻找一种结合"搜索"将邮件标记为已读的标准。
最初，过滤器是这样做的:
For Each item In strFolderPath.Items.Restrict("[unread] = true")
item.UnRead = False
Next
如前所述，日历类型的项目会出错，我肯定会尽最大努力避免On Error Resume Next。
当前方式:
For Each objMailItem In currentFolder.Items
If TypeName(objMailItem) <> "MeetingItem" And objMailItem.MessageClass <> "IPM.Schedule.Meeting.Request" Then
objMailItem.UnRead = False
End If
Next
冗长乏味。
CallAll
Sub CallAll()
'https://stackoverflow.com/questions/4365890/find-underlying-object-type-for-outlook-meetingitem
Dim InboxFolder As Folder
Dim SubFolder As Folder
Dim Folder As Folder
Dim objInbox As Outlook.MAPIFolder
Set myNamespace = Application.GetNamespace("MAPI")
Set objInbox = myNamespace.GetDefaultFolder(olFolderInbox)
Set InboxFolder = GetFolder(objInbox.FolderPath)
For Each Folder In InboxFolder.Folders
MarkAllRead (Folder.FolderPath)
Next
Set InboxFolder = Nothing
Set Folder = Nothing
End Sub
GetFolder
Function GetFolder(strFolderPath As String) As MAPIFolder
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim i As Long
strFolderPath = Replace(strFolderPath, "\", "")
strFolderPath = Replace(strFolderPath, "/", "")
arrFolders() = Split(strFolderPath, "")
Set objFolder = Application.GetNamespace("MAPI").Folders.item(arrFolders(0))
If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
End Function
GetSubFolder
Function GetSubFolders(strFolderPath As String) As Long
Dim WalkResultFolder As Folder
Dim Folder As Folder
Dim item As MailItem
Dim WalkResult As Long
Set WalkResultFolder = GetFolder(strFolderPath)
For Each Folder In WalkResultFolder.Folders
WalkResult = GetSubFolders(Folder.FolderPath)
MarkAllRead (Folder.FolderPath)
Next
Set ResultFolder = Nothing
Set Folder = Nothing
Set item = Nothing
End Function
MarkAllRead
Function MarkAllRead(folderName As String)
'https://stackoverflow.com/questions/4365890/find-underlying-object-type-for-outlook-meetingitem
Dim currentFolder As Folder
Dim objMailItem As MailItem
Set currentFolder = GetFolder(folderName)
For Each objMailItem In currentFolder.Items
Debug.Print "Folder Name: " & currentFolder
Debug.Print "Mail Item: " & objMailItem
If TypeName(objMailItem) <> "MeetingItem" And objMailItem.MessageClass <> "IPM.Schedule.Meeting.Request" Then
objMailItem.UnRead = False
End If
Next
For Each Folder In currentFolder.Folders
MarkAllRead (Folder.FolderPath)
Next
Set WalkResult = Nothing
End Sub
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Function MarkAllRead(folderName As String)
Dim SubFolder As Folder
Dim currentFolder As Folder
Dim objItem As Object
Dim objUnreadItems As items
Set currentFolder = GetFolder(folderName)
Debug.Print "Folder Name: " & currentFolder
Set objUnreadItems = currentFolder.items.Restrict("[Unread]=True")
For Each objItem In objUnreadItems
If TypeName(objItem) <> "MeetingItem" Then
Debug.Print "Object Item: " & objItem.Subject
If objItem.MessageClass <> "IPM.Schedule.Meeting.Request" Then
objItem.UnRead = False
End If
End If
Next
For Each SubFolder In currentFolder.folders
MarkAllRead (SubFolder.FolderPath)
Next
End Function