移动具有特定收件人的电子邮件答案

【问题标题】：Moving emails with specific repicient移动具有特定收件人的电子邮件
【发布时间】：2015-09-19 21:53:49
【问题描述】：

我想在阅读后将电子邮件移动到文件夹中。我是多个 DL 的一部分，我想要一个宏来检测 To: 字段中的 DL 并将电子邮件移动到特定文件夹。这是我目前所拥有的：

Sub move2folder()
On Error Resume Next

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolderSrc = objNamespace.GetDefaultFolder(olFolderInbox)
Set objFolderDst = objFolderSrc.Folders("_Reviewed")

Set colItems = objFolderSrc.Items
Set colFilteredItems = colItems.Restrict("[UnRead] = False")

For Each objMessage In colFilteredItems
objMessage.move objFolderDst
Next

End Sub

一旦阅读，这会将电子邮件移动到我想要的文件夹，但是我不确定让它识别电子邮件发送给谁的语法。如果这不可能，我可以让它检测发送电子邮件的域吗？

【问题讨论】：

标签： vba outlook

【解决方案1】：

像这样尝试 InStr。

Option Explicit

Sub move2folder()

Dim objOutlook As Outlook.Application
Dim objNameSpace As Namespace
Dim objFolderSrc As Folder
Dim objFolderDst As Folder
Dim colItems As Items
Dim colFilteredItems As Items
Dim i As Long

'On Error Resume Next

'Set objOutlook = CreateObject("Outlook.Application")
Set objOutlook = Application
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objFolderSrc = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objFolderDst = objFolderSrc.Folders("_Reviewed")

Set colItems = objFolderSrc.Items
Set colFilteredItems = colItems.Restrict("[UnRead] = False")


If colFilteredItems.count > 0 Then
    'For Each objMessage In colFilteredItems
    For i = colFilteredItems.count To 1 Step -1
        If InStr(colFilteredItems(i).To, "name of dist list") Then
            colFilteredItems(i).Move objFolderDst
        End If
    Next
End If

Set objOutlook = Nothing
Set objNameSpace = Nothing
Set objFolderSrc = Nothing
Set objFolderDst = Nothing
Set colItems = Nothing
Set colFilteredItems = Nothing

End Sub

按相反顺序删除或移动。

【讨论】：