如果邮件在其他文件夹中已读，则设置为已读

Question

我正在尝试制作一个outlook宏，它将'更新'邮件。我有一个收件箱文件夹和另一个。(2个邮件帐户)

有一个规则，就是把邮件从另一个文件夹复制到我的收件箱。

我的目标是将邮件设置为在另一个文件夹中已读，如果它在收件箱文件夹中已读。

Sub precitane()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim mydeffolder As Outlook.Folder
Dim items As Object
Dim defitems As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myDestFolder = myNameSpace.Folders("") 'mymail
Set mydeffolder = myNameSpace.GetDefaultFolder(olFolderInbox)

For Each items In myDestFolder.items
For Each defitems In mydeffolder.items
If TypeOf items Is Outlook.MailItem & TypeOf defitems Is Outlook.MailItem Then
Dim oMail As Outlook.MailItem: Set oMail = items
Dim defMail As Outlook.MailItem: Set defMail = defitems
If oMail.SenderEmailAddress = "" & defMail.SenderEmailAddress = "" & defMail.Body = oMail.Body & defMail.UnRead = False Then

oMail.UnRead = True
oMail.Save
End If
End If
Next
Next
On Error GoTo 0

End Sub

";"包含我的邮件…

Answer 1

看起来您尝试过使用VBA以外的代码。

我把If语句分成了不同的部分，因为这样更容易理解和调试。

Option Explicit
Sub precitane()
Dim myDestFolder As Folder
Dim mydeffolder As Folder
Dim item As Object
Dim defItem As Object
Set myDestFolder = Session.Folders("mailAddress2").Folders("Inbox").Folders("Test")
Set mydeffolder = Session.GetDefaultFolder(olFolderInbox).Folders("Test3")
For Each item In myDestFolder.items
If TypeOf item Is MailItem Then

For Each defItem In mydeffolder.items

If TypeOf defItem Is MailItem Then

If item.senderEmailAddress = defItem.senderEmailAddress Then
If item.Body = defItem.Body Then
If item.UnRead = False Then

defItem.UnRead = False

'If necessary
'item.Save

Exit For

End If
End If
End If
End If

Set defItem = Nothing

Next

End If

Set item = Nothing

Next
Debug.Print "Done."

End Sub