vba 如何根据附件文件名将邮件移动到文件夹？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12283189/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to move mail to a folder based on attachment filename?
提问by modzsi
I need a rule (or most probably a VBA macro) to sort my mails. In case I have per say "REPORT" in the filename of the attachment of a newly received mail than I would like to move that mail to a different folder, let say "REPORTS" folder.
我需要一个规则（或者很可能是一个 VBA 宏）来对我的邮件进行排序。如果我在新收到的邮件附件的文件名中说“REPORT”而不是将该邮件移动到其他文件夹，请说“REPORTS”文件夹。
How can I achieve this?
我怎样才能做到这一点？
I already to set a rule on the mail header but that did not seem to solve the matter.
我已经在邮件标题上设置了规则，但这似乎并没有解决问题。
Thanks in advance!
提前致谢！
采纳答案by Tim Williams
Used code from http://www.outlookcode.com/article.aspx?id=62and http://blog.saieva.com/2010/03/27/move-messages-to-folders-with-outlook-vba/
使用来自http://www.outlookcode.com/article.aspx?id=62和http://blog.saieva.com/2010/03/27/move-messages-to-folders-with-outlook-vba 的代码/
'code goes in "ThisOutlookSession" module
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim arr() As String
Dim i As Integer
Dim ns As Outlook.NameSpace
Dim itm As MailItem
Dim m As Outlook.MailItem
Dim att As Outlook.Attachment
On Error Resume Next
Set ns = Application.Session
arr = Split(EntryIDCollection, ",")
For i = 0 To UBound(arr)
Set itm = ns.GetItemFromID(arr(i))
If itm.Class = olMail Then
Set m = itm
If m.Attachments.Count > 0 Then
For Each att In m.Attachments
If UCase(att.FileName) Like "*REPORT*" Then
MoveToFolder m, "MoveTest"
Exit For
End If
Next att
End If
End If
Next
Set ns = Nothing
Set itm = Nothing
Set m = Nothing
End Sub
Sub MoveToFolder(mItem As MailItem, folderName)
'###you need to edit this for your account name###
Const mailboxNameString As String = "Mailbox - firstname lastname"
Dim olApp As New Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olDestFolder As Outlook.MAPIFolder
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olDestFolder = olNameSpace.Folders(mailboxNameString).Folders(folderName)
Debug.Print "[" & Date & " " & Time & "] " & _
": folder = " & folderName & _
"; subject = " & mItem.Subject & "..."
mItem.Move olDestFolder
End Sub
