移动具有特定复制功能的电子邮件

Question

我想在阅读后将电子邮件移到文件夹中。我是多个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

这会将电子邮件移动到我想要的文件夹，但是我不确定语法是否让它识别出电子邮件的发送者。如果无法做到这一点，我是否可以检测到电子邮件发送的域名？

Answer 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

删除或按相反顺序移动。